module Network.CAN.Types
  (
  -- * Arbitration
    CANArbitrationField(..)
  , standardID
  , extendedID
  , setRTR
  -- * Message
  , CANMessage(..)
  , standardMessage
  ) where

import Data.Word (Word8, Word16, Word32)
import Test.QuickCheck (Arbitrary(..))

import qualified Test.QuickCheck

-- * Arbitration

data CANArbitrationField = CANArbitrationField
  { CANArbitrationField -> Word32
canArbitrationFieldID :: Word32 -- ^ CAN ID
  , CANArbitrationField -> Bool
canArbitrationFieldExtended :: Bool -- ^ Extended CAN ID
  , CANArbitrationField -> Bool
canArbitrationFieldRTR :: Bool -- ^ Remote transmission request
  } deriving (CANArbitrationField -> CANArbitrationField -> Bool
(CANArbitrationField -> CANArbitrationField -> Bool)
-> (CANArbitrationField -> CANArbitrationField -> Bool)
-> Eq CANArbitrationField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CANArbitrationField -> CANArbitrationField -> Bool
== :: CANArbitrationField -> CANArbitrationField -> Bool
$c/= :: CANArbitrationField -> CANArbitrationField -> Bool
/= :: CANArbitrationField -> CANArbitrationField -> Bool
Eq, Eq CANArbitrationField
Eq CANArbitrationField =>
(CANArbitrationField -> CANArbitrationField -> Ordering)
-> (CANArbitrationField -> CANArbitrationField -> Bool)
-> (CANArbitrationField -> CANArbitrationField -> Bool)
-> (CANArbitrationField -> CANArbitrationField -> Bool)
-> (CANArbitrationField -> CANArbitrationField -> Bool)
-> (CANArbitrationField
    -> CANArbitrationField -> CANArbitrationField)
-> (CANArbitrationField
    -> CANArbitrationField -> CANArbitrationField)
-> Ord CANArbitrationField
CANArbitrationField -> CANArbitrationField -> Bool
CANArbitrationField -> CANArbitrationField -> Ordering
CANArbitrationField -> CANArbitrationField -> CANArbitrationField
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CANArbitrationField -> CANArbitrationField -> Ordering
compare :: CANArbitrationField -> CANArbitrationField -> Ordering
$c< :: CANArbitrationField -> CANArbitrationField -> Bool
< :: CANArbitrationField -> CANArbitrationField -> Bool
$c<= :: CANArbitrationField -> CANArbitrationField -> Bool
<= :: CANArbitrationField -> CANArbitrationField -> Bool
$c> :: CANArbitrationField -> CANArbitrationField -> Bool
> :: CANArbitrationField -> CANArbitrationField -> Bool
$c>= :: CANArbitrationField -> CANArbitrationField -> Bool
>= :: CANArbitrationField -> CANArbitrationField -> Bool
$cmax :: CANArbitrationField -> CANArbitrationField -> CANArbitrationField
max :: CANArbitrationField -> CANArbitrationField -> CANArbitrationField
$cmin :: CANArbitrationField -> CANArbitrationField -> CANArbitrationField
min :: CANArbitrationField -> CANArbitrationField -> CANArbitrationField
Ord, Int -> CANArbitrationField -> ShowS
[CANArbitrationField] -> ShowS
CANArbitrationField -> String
(Int -> CANArbitrationField -> ShowS)
-> (CANArbitrationField -> String)
-> ([CANArbitrationField] -> ShowS)
-> Show CANArbitrationField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CANArbitrationField -> ShowS
showsPrec :: Int -> CANArbitrationField -> ShowS
$cshow :: CANArbitrationField -> String
show :: CANArbitrationField -> String
$cshowList :: [CANArbitrationField] -> ShowS
showList :: [CANArbitrationField] -> ShowS
Show)

instance Arbitrary CANArbitrationField where
  arbitrary :: Gen CANArbitrationField
arbitrary = do
    Bool
rtr <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    Bool
ext <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    Word32
cid <-
      if Bool
ext
      then (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
Test.QuickCheck.choose (Word32
0, Word32
0x3FFFFFFF)
      else (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
Test.QuickCheck.choose (Word32
0, Word32
0xFFF)
    CANArbitrationField -> Gen CANArbitrationField
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CANArbitrationField
      { canArbitrationFieldID :: Word32
canArbitrationFieldID = Word32
cid
      , canArbitrationFieldExtended :: Bool
canArbitrationFieldExtended = Bool
ext
      , canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR = Bool
rtr
      }

-- | Construct standard CAN ID (11 bits)
standardID
  :: Word16
  -> CANArbitrationField
standardID :: Word16 -> CANArbitrationField
standardID Word16
cid = CANArbitrationField
  { canArbitrationFieldID :: Word32
canArbitrationFieldID = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cid
  , canArbitrationFieldExtended :: Bool
canArbitrationFieldExtended = Bool
False
  , canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR = Bool
False
  }

-- | Construct extended CAN ID (29 bits)
extendedID
  :: Word32
  -> CANArbitrationField
extendedID :: Word32 -> CANArbitrationField
extendedID Word32
cid = CANArbitrationField
  { canArbitrationFieldID :: Word32
canArbitrationFieldID = Word32
cid
  , canArbitrationFieldExtended :: Bool
canArbitrationFieldExtended = Bool
True
  , canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR = Bool
False
  }

-- | Set remote transmission request bit
setRTR
  :: CANArbitrationField
  -> CANArbitrationField
setRTR :: CANArbitrationField -> CANArbitrationField
setRTR CANArbitrationField
cf = CANArbitrationField
cf { canArbitrationFieldRTR = True }

data CANMessage = CANMessage
  { CANMessage -> CANArbitrationField
canMessageArbitrationField :: CANArbitrationField
  , CANMessage -> [Word8]
canMessageData :: [Word8]
  } deriving (CANMessage -> CANMessage -> Bool
(CANMessage -> CANMessage -> Bool)
-> (CANMessage -> CANMessage -> Bool) -> Eq CANMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CANMessage -> CANMessage -> Bool
== :: CANMessage -> CANMessage -> Bool
$c/= :: CANMessage -> CANMessage -> Bool
/= :: CANMessage -> CANMessage -> Bool
Eq, Eq CANMessage
Eq CANMessage =>
(CANMessage -> CANMessage -> Ordering)
-> (CANMessage -> CANMessage -> Bool)
-> (CANMessage -> CANMessage -> Bool)
-> (CANMessage -> CANMessage -> Bool)
-> (CANMessage -> CANMessage -> Bool)
-> (CANMessage -> CANMessage -> CANMessage)
-> (CANMessage -> CANMessage -> CANMessage)
-> Ord CANMessage
CANMessage -> CANMessage -> Bool
CANMessage -> CANMessage -> Ordering
CANMessage -> CANMessage -> CANMessage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CANMessage -> CANMessage -> Ordering
compare :: CANMessage -> CANMessage -> Ordering
$c< :: CANMessage -> CANMessage -> Bool
< :: CANMessage -> CANMessage -> Bool
$c<= :: CANMessage -> CANMessage -> Bool
<= :: CANMessage -> CANMessage -> Bool
$c> :: CANMessage -> CANMessage -> Bool
> :: CANMessage -> CANMessage -> Bool
$c>= :: CANMessage -> CANMessage -> Bool
>= :: CANMessage -> CANMessage -> Bool
$cmax :: CANMessage -> CANMessage -> CANMessage
max :: CANMessage -> CANMessage -> CANMessage
$cmin :: CANMessage -> CANMessage -> CANMessage
min :: CANMessage -> CANMessage -> CANMessage
Ord, Int -> CANMessage -> ShowS
[CANMessage] -> ShowS
CANMessage -> String
(Int -> CANMessage -> ShowS)
-> (CANMessage -> String)
-> ([CANMessage] -> ShowS)
-> Show CANMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CANMessage -> ShowS
showsPrec :: Int -> CANMessage -> ShowS
$cshow :: CANMessage -> String
show :: CANMessage -> String
$cshowList :: [CANMessage] -> ShowS
showList :: [CANMessage] -> ShowS
Show)

instance Arbitrary CANMessage where
  arbitrary :: Gen CANMessage
arbitrary = do
    CANArbitrationField
arb <- Gen CANArbitrationField
forall a. Arbitrary a => Gen a
arbitrary
    Int
len <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
Test.QuickCheck.choose (Int
0, Int
8)
    [Word8]
dat <- Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
Test.QuickCheck.vectorOf Int
len Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    CANMessage -> Gen CANMessage
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CANMessage
      { canMessageArbitrationField :: CANArbitrationField
canMessageArbitrationField = CANArbitrationField
arb
      , canMessageData :: [Word8]
canMessageData = [Word8]
dat
      }

-- | Create standard CAN message
standardMessage
  :: Word16
  -> [Word8]
  -> CANMessage
standardMessage :: Word16 -> [Word8] -> CANMessage
standardMessage Word16
cid [Word8]
cdata = CANMessage
  { canMessageArbitrationField :: CANArbitrationField
canMessageArbitrationField = Word16 -> CANArbitrationField
standardID Word16
cid
  , canMessageData :: [Word8]
canMessageData = [Word8]
cdata
  }