{-# LANGUAGE RecordWildCards #-}

-- | Translation between CANMessage and SocketCANFrame

module Network.SocketCAN.Translate
  ( toSocketCANFrame
  , fromSocketCANFrame
  ) where

import Data.Bits ((.&.), (.|.), shiftL)
import Data.Word (Word32)
import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))
import Network.SocketCAN.Bindings (SocketCANArbitrationField(..), SocketCANFrame(..))
import qualified Data.Bool

toSocketCANFrame
  :: CANMessage
  -> SocketCANFrame
toSocketCANFrame :: CANMessage -> SocketCANFrame
toSocketCANFrame CANMessage{[Word8]
CANArbitrationField
canMessageArbitrationField :: CANArbitrationField
canMessageData :: [Word8]
canMessageData :: CANMessage -> [Word8]
canMessageArbitrationField :: CANMessage -> CANArbitrationField
..} =
  SocketCANFrame
  { socketCANFrameArbitrationField :: SocketCANArbitrationField
socketCANFrameArbitrationField =
      CANArbitrationField -> SocketCANArbitrationField
toSocketCANArbitrationField
        CANArbitrationField
canMessageArbitrationField
  , socketCANFrameLength :: Word8
socketCANFrameLength =
      Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
canMessageData
  , socketCANFrameData :: [Word8]
socketCANFrameData = [Word8]
canMessageData
  }

fromSocketCANFrame
  :: SocketCANFrame
  -> CANMessage
fromSocketCANFrame :: SocketCANFrame -> CANMessage
fromSocketCANFrame SocketCANFrame{[Word8]
Word8
SocketCANArbitrationField
socketCANFrameArbitrationField :: SocketCANFrame -> SocketCANArbitrationField
socketCANFrameLength :: SocketCANFrame -> Word8
socketCANFrameData :: SocketCANFrame -> [Word8]
socketCANFrameArbitrationField :: SocketCANArbitrationField
socketCANFrameLength :: Word8
socketCANFrameData :: [Word8]
..} =
  CANMessage
  { canMessageArbitrationField :: CANArbitrationField
canMessageArbitrationField =
      SocketCANArbitrationField -> CANArbitrationField
fromSocketCANArbitrationField
        SocketCANArbitrationField
socketCANFrameArbitrationField
  , canMessageData :: [Word8]
canMessageData = [Word8]
socketCANFrameData
  }

toSocketCANArbitrationField
  :: CANArbitrationField
  -> SocketCANArbitrationField
toSocketCANArbitrationField :: CANArbitrationField -> SocketCANArbitrationField
toSocketCANArbitrationField CANArbitrationField{Bool
Word32
canArbitrationFieldID :: Word32
canArbitrationFieldExtended :: Bool
canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR :: CANArbitrationField -> Bool
canArbitrationFieldExtended :: CANArbitrationField -> Bool
canArbitrationFieldID :: CANArbitrationField -> Word32
..} =
  Word32 -> SocketCANArbitrationField
SocketCANArbitrationField
  (Word32 -> SocketCANArbitrationField)
-> Word32 -> SocketCANArbitrationField
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32)
-> (Word32 -> Word32) -> Bool -> Word32 -> Word32
forall a. a -> a -> Bool -> a
Data.Bool.bool
      Word32 -> Word32
forall a. a -> a
id
      (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
effBit)
      Bool
canArbitrationFieldExtended
  (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32)
-> (Word32 -> Word32) -> Bool -> Word32 -> Word32
forall a. a -> a -> Bool -> a
Data.Bool.bool
      Word32 -> Word32
forall a. a -> a
id
      (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
rtrBit)
      Bool
canArbitrationFieldRTR
  (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
canArbitrationFieldID

fromSocketCANArbitrationField
  :: SocketCANArbitrationField
  -> CANArbitrationField
fromSocketCANArbitrationField :: SocketCANArbitrationField -> CANArbitrationField
fromSocketCANArbitrationField (SocketCANArbitrationField Word32
scid) =
  let
    isEff :: Bool
isEff = Word32
scid Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
effBit Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
  in
    CANArbitrationField
    { canArbitrationFieldID :: Word32
canArbitrationFieldID =
        (Word32 -> Word32)
-> (Word32 -> Word32) -> Bool -> Word32 -> Word32
forall a. a -> a -> Bool -> a
Data.Bool.bool
          (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
12 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1))
          (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1))
          Bool
isEff
        (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
scid
    , canArbitrationFieldExtended :: Bool
canArbitrationFieldExtended = Bool
isEff
    , canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR = Word32
scid Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
rtrBit Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
    }

effBit :: Word32
effBit :: Word32
effBit = Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
31

rtrBit :: Word32
rtrBit :: Word32
rtrBit = Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
30