{-# LANGUAGE NumericUnderscores #-}
module Network.SLCAN.Types
  ( SLCANMessage(..)
  , SLCANControl(..)
  , SLCANBitrate(..)
  , numericBitrate
  , SLCANState(..)
  , SLCANCounters(..)
  , SLCANError(..)
  , SLCANConfig(..)
  ) where

import Data.Default.Class (Default(def))
import Data.Set (Set)
import Data.Word (Word16)
import Network.CAN.Types (CANMessage)
import Test.QuickCheck (Arbitrary(..))

import qualified Test.QuickCheck

data SLCANMessage
  = SLCANMessage_Control SLCANControl
  | SLCANMessage_Data CANMessage
  | SLCANMessage_State SLCANState SLCANCounters
  | SLCANMessage_Error (Set SLCANError)
  deriving (SLCANMessage -> SLCANMessage -> Bool
(SLCANMessage -> SLCANMessage -> Bool)
-> (SLCANMessage -> SLCANMessage -> Bool) -> Eq SLCANMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANMessage -> SLCANMessage -> Bool
== :: SLCANMessage -> SLCANMessage -> Bool
$c/= :: SLCANMessage -> SLCANMessage -> Bool
/= :: SLCANMessage -> SLCANMessage -> Bool
Eq, Eq SLCANMessage
Eq SLCANMessage =>
(SLCANMessage -> SLCANMessage -> Ordering)
-> (SLCANMessage -> SLCANMessage -> Bool)
-> (SLCANMessage -> SLCANMessage -> Bool)
-> (SLCANMessage -> SLCANMessage -> Bool)
-> (SLCANMessage -> SLCANMessage -> Bool)
-> (SLCANMessage -> SLCANMessage -> SLCANMessage)
-> (SLCANMessage -> SLCANMessage -> SLCANMessage)
-> Ord SLCANMessage
SLCANMessage -> SLCANMessage -> Bool
SLCANMessage -> SLCANMessage -> Ordering
SLCANMessage -> SLCANMessage -> SLCANMessage
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 :: SLCANMessage -> SLCANMessage -> Ordering
compare :: SLCANMessage -> SLCANMessage -> Ordering
$c< :: SLCANMessage -> SLCANMessage -> Bool
< :: SLCANMessage -> SLCANMessage -> Bool
$c<= :: SLCANMessage -> SLCANMessage -> Bool
<= :: SLCANMessage -> SLCANMessage -> Bool
$c> :: SLCANMessage -> SLCANMessage -> Bool
> :: SLCANMessage -> SLCANMessage -> Bool
$c>= :: SLCANMessage -> SLCANMessage -> Bool
>= :: SLCANMessage -> SLCANMessage -> Bool
$cmax :: SLCANMessage -> SLCANMessage -> SLCANMessage
max :: SLCANMessage -> SLCANMessage -> SLCANMessage
$cmin :: SLCANMessage -> SLCANMessage -> SLCANMessage
min :: SLCANMessage -> SLCANMessage -> SLCANMessage
Ord, Int -> SLCANMessage -> ShowS
[SLCANMessage] -> ShowS
SLCANMessage -> String
(Int -> SLCANMessage -> ShowS)
-> (SLCANMessage -> String)
-> ([SLCANMessage] -> ShowS)
-> Show SLCANMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANMessage -> ShowS
showsPrec :: Int -> SLCANMessage -> ShowS
$cshow :: SLCANMessage -> String
show :: SLCANMessage -> String
$cshowList :: [SLCANMessage] -> ShowS
showList :: [SLCANMessage] -> ShowS
Show)

instance Arbitrary SLCANMessage where
  arbitrary :: Gen SLCANMessage
arbitrary = [Gen SLCANMessage] -> Gen SLCANMessage
forall a. HasCallStack => [Gen a] -> Gen a
Test.QuickCheck.oneof
    [ SLCANControl -> SLCANMessage
SLCANMessage_Control (SLCANControl -> SLCANMessage)
-> Gen SLCANControl -> Gen SLCANMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SLCANControl
forall a. Arbitrary a => Gen a
arbitrary
    , CANMessage -> SLCANMessage
SLCANMessage_Data (CANMessage -> SLCANMessage) -> Gen CANMessage -> Gen SLCANMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CANMessage
forall a. Arbitrary a => Gen a
arbitrary
    , SLCANState -> SLCANCounters -> SLCANMessage
SLCANMessage_State (SLCANState -> SLCANCounters -> SLCANMessage)
-> Gen SLCANState -> Gen (SLCANCounters -> SLCANMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SLCANState
forall a. Arbitrary a => Gen a
arbitrary Gen (SLCANCounters -> SLCANMessage)
-> Gen SLCANCounters -> Gen SLCANMessage
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SLCANCounters
forall a. Arbitrary a => Gen a
arbitrary
    , Set SLCANError -> SLCANMessage
SLCANMessage_Error (Set SLCANError -> SLCANMessage)
-> Gen (Set SLCANError) -> Gen SLCANMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set SLCANError)
forall a. Arbitrary a => Gen a
arbitrary
    ]

data SLCANControl
  = SLCANControl_Open
  | SLCANControl_Close
  | SLCANControl_Bitrate SLCANBitrate
  | SLCANControl_ResetErrors
  | SLCANControl_ListenOnly
  deriving (SLCANControl -> SLCANControl -> Bool
(SLCANControl -> SLCANControl -> Bool)
-> (SLCANControl -> SLCANControl -> Bool) -> Eq SLCANControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANControl -> SLCANControl -> Bool
== :: SLCANControl -> SLCANControl -> Bool
$c/= :: SLCANControl -> SLCANControl -> Bool
/= :: SLCANControl -> SLCANControl -> Bool
Eq, Eq SLCANControl
Eq SLCANControl =>
(SLCANControl -> SLCANControl -> Ordering)
-> (SLCANControl -> SLCANControl -> Bool)
-> (SLCANControl -> SLCANControl -> Bool)
-> (SLCANControl -> SLCANControl -> Bool)
-> (SLCANControl -> SLCANControl -> Bool)
-> (SLCANControl -> SLCANControl -> SLCANControl)
-> (SLCANControl -> SLCANControl -> SLCANControl)
-> Ord SLCANControl
SLCANControl -> SLCANControl -> Bool
SLCANControl -> SLCANControl -> Ordering
SLCANControl -> SLCANControl -> SLCANControl
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 :: SLCANControl -> SLCANControl -> Ordering
compare :: SLCANControl -> SLCANControl -> Ordering
$c< :: SLCANControl -> SLCANControl -> Bool
< :: SLCANControl -> SLCANControl -> Bool
$c<= :: SLCANControl -> SLCANControl -> Bool
<= :: SLCANControl -> SLCANControl -> Bool
$c> :: SLCANControl -> SLCANControl -> Bool
> :: SLCANControl -> SLCANControl -> Bool
$c>= :: SLCANControl -> SLCANControl -> Bool
>= :: SLCANControl -> SLCANControl -> Bool
$cmax :: SLCANControl -> SLCANControl -> SLCANControl
max :: SLCANControl -> SLCANControl -> SLCANControl
$cmin :: SLCANControl -> SLCANControl -> SLCANControl
min :: SLCANControl -> SLCANControl -> SLCANControl
Ord, Int -> SLCANControl -> ShowS
[SLCANControl] -> ShowS
SLCANControl -> String
(Int -> SLCANControl -> ShowS)
-> (SLCANControl -> String)
-> ([SLCANControl] -> ShowS)
-> Show SLCANControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANControl -> ShowS
showsPrec :: Int -> SLCANControl -> ShowS
$cshow :: SLCANControl -> String
show :: SLCANControl -> String
$cshowList :: [SLCANControl] -> ShowS
showList :: [SLCANControl] -> ShowS
Show)

instance Arbitrary SLCANControl where
  arbitrary :: Gen SLCANControl
arbitrary = [Gen SLCANControl] -> Gen SLCANControl
forall a. HasCallStack => [Gen a] -> Gen a
Test.QuickCheck.oneof
    [ SLCANControl -> Gen SLCANControl
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SLCANControl
SLCANControl_Open
    , SLCANControl -> Gen SLCANControl
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SLCANControl
SLCANControl_Close
    , SLCANBitrate -> SLCANControl
SLCANControl_Bitrate (SLCANBitrate -> SLCANControl)
-> Gen SLCANBitrate -> Gen SLCANControl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SLCANBitrate
forall a. Arbitrary a => Gen a
arbitrary
    , SLCANControl -> Gen SLCANControl
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SLCANControl
SLCANControl_ResetErrors
    , SLCANControl -> Gen SLCANControl
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SLCANControl
SLCANControl_ListenOnly
    ]

data SLCANBitrate
  = SLCANBitrate_10K
  | SLCANBitrate_20K
  | SLCANBitrate_50K
  | SLCANBitrate_100K
  | SLCANBitrate_125K
  | SLCANBitrate_250K
  | SLCANBitrate_500K
  | SLCANBitrate_800K
  | SLCANBitrate_1M
  deriving (SLCANBitrate
SLCANBitrate -> SLCANBitrate -> Bounded SLCANBitrate
forall a. a -> a -> Bounded a
$cminBound :: SLCANBitrate
minBound :: SLCANBitrate
$cmaxBound :: SLCANBitrate
maxBound :: SLCANBitrate
Bounded, SLCANBitrate -> SLCANBitrate -> Bool
(SLCANBitrate -> SLCANBitrate -> Bool)
-> (SLCANBitrate -> SLCANBitrate -> Bool) -> Eq SLCANBitrate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANBitrate -> SLCANBitrate -> Bool
== :: SLCANBitrate -> SLCANBitrate -> Bool
$c/= :: SLCANBitrate -> SLCANBitrate -> Bool
/= :: SLCANBitrate -> SLCANBitrate -> Bool
Eq, Int -> SLCANBitrate
SLCANBitrate -> Int
SLCANBitrate -> [SLCANBitrate]
SLCANBitrate -> SLCANBitrate
SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
SLCANBitrate -> SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
(SLCANBitrate -> SLCANBitrate)
-> (SLCANBitrate -> SLCANBitrate)
-> (Int -> SLCANBitrate)
-> (SLCANBitrate -> Int)
-> (SLCANBitrate -> [SLCANBitrate])
-> (SLCANBitrate -> SLCANBitrate -> [SLCANBitrate])
-> (SLCANBitrate -> SLCANBitrate -> [SLCANBitrate])
-> (SLCANBitrate -> SLCANBitrate -> SLCANBitrate -> [SLCANBitrate])
-> Enum SLCANBitrate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SLCANBitrate -> SLCANBitrate
succ :: SLCANBitrate -> SLCANBitrate
$cpred :: SLCANBitrate -> SLCANBitrate
pred :: SLCANBitrate -> SLCANBitrate
$ctoEnum :: Int -> SLCANBitrate
toEnum :: Int -> SLCANBitrate
$cfromEnum :: SLCANBitrate -> Int
fromEnum :: SLCANBitrate -> Int
$cenumFrom :: SLCANBitrate -> [SLCANBitrate]
enumFrom :: SLCANBitrate -> [SLCANBitrate]
$cenumFromThen :: SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
enumFromThen :: SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
$cenumFromTo :: SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
enumFromTo :: SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
$cenumFromThenTo :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
enumFromThenTo :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate -> [SLCANBitrate]
Enum, Eq SLCANBitrate
Eq SLCANBitrate =>
(SLCANBitrate -> SLCANBitrate -> Ordering)
-> (SLCANBitrate -> SLCANBitrate -> Bool)
-> (SLCANBitrate -> SLCANBitrate -> Bool)
-> (SLCANBitrate -> SLCANBitrate -> Bool)
-> (SLCANBitrate -> SLCANBitrate -> Bool)
-> (SLCANBitrate -> SLCANBitrate -> SLCANBitrate)
-> (SLCANBitrate -> SLCANBitrate -> SLCANBitrate)
-> Ord SLCANBitrate
SLCANBitrate -> SLCANBitrate -> Bool
SLCANBitrate -> SLCANBitrate -> Ordering
SLCANBitrate -> SLCANBitrate -> SLCANBitrate
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 :: SLCANBitrate -> SLCANBitrate -> Ordering
compare :: SLCANBitrate -> SLCANBitrate -> Ordering
$c< :: SLCANBitrate -> SLCANBitrate -> Bool
< :: SLCANBitrate -> SLCANBitrate -> Bool
$c<= :: SLCANBitrate -> SLCANBitrate -> Bool
<= :: SLCANBitrate -> SLCANBitrate -> Bool
$c> :: SLCANBitrate -> SLCANBitrate -> Bool
> :: SLCANBitrate -> SLCANBitrate -> Bool
$c>= :: SLCANBitrate -> SLCANBitrate -> Bool
>= :: SLCANBitrate -> SLCANBitrate -> Bool
$cmax :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate
max :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate
$cmin :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate
min :: SLCANBitrate -> SLCANBitrate -> SLCANBitrate
Ord, Int -> SLCANBitrate -> ShowS
[SLCANBitrate] -> ShowS
SLCANBitrate -> String
(Int -> SLCANBitrate -> ShowS)
-> (SLCANBitrate -> String)
-> ([SLCANBitrate] -> ShowS)
-> Show SLCANBitrate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANBitrate -> ShowS
showsPrec :: Int -> SLCANBitrate -> ShowS
$cshow :: SLCANBitrate -> String
show :: SLCANBitrate -> String
$cshowList :: [SLCANBitrate] -> ShowS
showList :: [SLCANBitrate] -> ShowS
Show)

instance Arbitrary SLCANBitrate where
  arbitrary :: Gen SLCANBitrate
arbitrary = Gen SLCANBitrate
forall a. (Bounded a, Enum a) => Gen a
Test.QuickCheck.arbitraryBoundedEnum

instance Default SLCANBitrate where
  def :: SLCANBitrate
def = SLCANBitrate
SLCANBitrate_1M

numericBitrate :: SLCANBitrate -> Int
numericBitrate :: SLCANBitrate -> Int
numericBitrate SLCANBitrate
SLCANBitrate_10K  =    Int
10_000
numericBitrate SLCANBitrate
SLCANBitrate_20K  =    Int
20_000
numericBitrate SLCANBitrate
SLCANBitrate_50K  =    Int
50_000
numericBitrate SLCANBitrate
SLCANBitrate_100K =   Int
100_000
numericBitrate SLCANBitrate
SLCANBitrate_125K =   Int
125_000
numericBitrate SLCANBitrate
SLCANBitrate_250K =   Int
250_000
numericBitrate SLCANBitrate
SLCANBitrate_500K =   Int
500_000
numericBitrate SLCANBitrate
SLCANBitrate_800K =   Int
800_000
numericBitrate SLCANBitrate
SLCANBitrate_1M   = Int
1_000_000

data SLCANState
  = SLCANState_Active
  | SLCANState_Warning
  | SLCANState_Passive
  | SLCANState_BusOff
  deriving (SLCANState
SLCANState -> SLCANState -> Bounded SLCANState
forall a. a -> a -> Bounded a
$cminBound :: SLCANState
minBound :: SLCANState
$cmaxBound :: SLCANState
maxBound :: SLCANState
Bounded, SLCANState -> SLCANState -> Bool
(SLCANState -> SLCANState -> Bool)
-> (SLCANState -> SLCANState -> Bool) -> Eq SLCANState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANState -> SLCANState -> Bool
== :: SLCANState -> SLCANState -> Bool
$c/= :: SLCANState -> SLCANState -> Bool
/= :: SLCANState -> SLCANState -> Bool
Eq, Int -> SLCANState
SLCANState -> Int
SLCANState -> [SLCANState]
SLCANState -> SLCANState
SLCANState -> SLCANState -> [SLCANState]
SLCANState -> SLCANState -> SLCANState -> [SLCANState]
(SLCANState -> SLCANState)
-> (SLCANState -> SLCANState)
-> (Int -> SLCANState)
-> (SLCANState -> Int)
-> (SLCANState -> [SLCANState])
-> (SLCANState -> SLCANState -> [SLCANState])
-> (SLCANState -> SLCANState -> [SLCANState])
-> (SLCANState -> SLCANState -> SLCANState -> [SLCANState])
-> Enum SLCANState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SLCANState -> SLCANState
succ :: SLCANState -> SLCANState
$cpred :: SLCANState -> SLCANState
pred :: SLCANState -> SLCANState
$ctoEnum :: Int -> SLCANState
toEnum :: Int -> SLCANState
$cfromEnum :: SLCANState -> Int
fromEnum :: SLCANState -> Int
$cenumFrom :: SLCANState -> [SLCANState]
enumFrom :: SLCANState -> [SLCANState]
$cenumFromThen :: SLCANState -> SLCANState -> [SLCANState]
enumFromThen :: SLCANState -> SLCANState -> [SLCANState]
$cenumFromTo :: SLCANState -> SLCANState -> [SLCANState]
enumFromTo :: SLCANState -> SLCANState -> [SLCANState]
$cenumFromThenTo :: SLCANState -> SLCANState -> SLCANState -> [SLCANState]
enumFromThenTo :: SLCANState -> SLCANState -> SLCANState -> [SLCANState]
Enum, Eq SLCANState
Eq SLCANState =>
(SLCANState -> SLCANState -> Ordering)
-> (SLCANState -> SLCANState -> Bool)
-> (SLCANState -> SLCANState -> Bool)
-> (SLCANState -> SLCANState -> Bool)
-> (SLCANState -> SLCANState -> Bool)
-> (SLCANState -> SLCANState -> SLCANState)
-> (SLCANState -> SLCANState -> SLCANState)
-> Ord SLCANState
SLCANState -> SLCANState -> Bool
SLCANState -> SLCANState -> Ordering
SLCANState -> SLCANState -> SLCANState
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 :: SLCANState -> SLCANState -> Ordering
compare :: SLCANState -> SLCANState -> Ordering
$c< :: SLCANState -> SLCANState -> Bool
< :: SLCANState -> SLCANState -> Bool
$c<= :: SLCANState -> SLCANState -> Bool
<= :: SLCANState -> SLCANState -> Bool
$c> :: SLCANState -> SLCANState -> Bool
> :: SLCANState -> SLCANState -> Bool
$c>= :: SLCANState -> SLCANState -> Bool
>= :: SLCANState -> SLCANState -> Bool
$cmax :: SLCANState -> SLCANState -> SLCANState
max :: SLCANState -> SLCANState -> SLCANState
$cmin :: SLCANState -> SLCANState -> SLCANState
min :: SLCANState -> SLCANState -> SLCANState
Ord, Int -> SLCANState -> ShowS
[SLCANState] -> ShowS
SLCANState -> String
(Int -> SLCANState -> ShowS)
-> (SLCANState -> String)
-> ([SLCANState] -> ShowS)
-> Show SLCANState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANState -> ShowS
showsPrec :: Int -> SLCANState -> ShowS
$cshow :: SLCANState -> String
show :: SLCANState -> String
$cshowList :: [SLCANState] -> ShowS
showList :: [SLCANState] -> ShowS
Show)

instance Arbitrary SLCANState where
  arbitrary :: Gen SLCANState
arbitrary = Gen SLCANState
forall a. (Bounded a, Enum a) => Gen a
Test.QuickCheck.arbitraryBoundedEnum

data SLCANCounters = SLCANCounters
  { SLCANCounters -> Word16
slCANCountersRxErrors :: Word16
  , SLCANCounters -> Word16
slCANCountersTxErrors :: Word16
  } deriving (SLCANCounters -> SLCANCounters -> Bool
(SLCANCounters -> SLCANCounters -> Bool)
-> (SLCANCounters -> SLCANCounters -> Bool) -> Eq SLCANCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANCounters -> SLCANCounters -> Bool
== :: SLCANCounters -> SLCANCounters -> Bool
$c/= :: SLCANCounters -> SLCANCounters -> Bool
/= :: SLCANCounters -> SLCANCounters -> Bool
Eq, Eq SLCANCounters
Eq SLCANCounters =>
(SLCANCounters -> SLCANCounters -> Ordering)
-> (SLCANCounters -> SLCANCounters -> Bool)
-> (SLCANCounters -> SLCANCounters -> Bool)
-> (SLCANCounters -> SLCANCounters -> Bool)
-> (SLCANCounters -> SLCANCounters -> Bool)
-> (SLCANCounters -> SLCANCounters -> SLCANCounters)
-> (SLCANCounters -> SLCANCounters -> SLCANCounters)
-> Ord SLCANCounters
SLCANCounters -> SLCANCounters -> Bool
SLCANCounters -> SLCANCounters -> Ordering
SLCANCounters -> SLCANCounters -> SLCANCounters
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 :: SLCANCounters -> SLCANCounters -> Ordering
compare :: SLCANCounters -> SLCANCounters -> Ordering
$c< :: SLCANCounters -> SLCANCounters -> Bool
< :: SLCANCounters -> SLCANCounters -> Bool
$c<= :: SLCANCounters -> SLCANCounters -> Bool
<= :: SLCANCounters -> SLCANCounters -> Bool
$c> :: SLCANCounters -> SLCANCounters -> Bool
> :: SLCANCounters -> SLCANCounters -> Bool
$c>= :: SLCANCounters -> SLCANCounters -> Bool
>= :: SLCANCounters -> SLCANCounters -> Bool
$cmax :: SLCANCounters -> SLCANCounters -> SLCANCounters
max :: SLCANCounters -> SLCANCounters -> SLCANCounters
$cmin :: SLCANCounters -> SLCANCounters -> SLCANCounters
min :: SLCANCounters -> SLCANCounters -> SLCANCounters
Ord, Int -> SLCANCounters -> ShowS
[SLCANCounters] -> ShowS
SLCANCounters -> String
(Int -> SLCANCounters -> ShowS)
-> (SLCANCounters -> String)
-> ([SLCANCounters] -> ShowS)
-> Show SLCANCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANCounters -> ShowS
showsPrec :: Int -> SLCANCounters -> ShowS
$cshow :: SLCANCounters -> String
show :: SLCANCounters -> String
$cshowList :: [SLCANCounters] -> ShowS
showList :: [SLCANCounters] -> ShowS
Show)

instance Arbitrary SLCANCounters where
  arbitrary :: Gen SLCANCounters
arbitrary =
    Word16 -> Word16 -> SLCANCounters
SLCANCounters
      (Word16 -> Word16 -> SLCANCounters)
-> Gen Word16 -> Gen (Word16 -> SLCANCounters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
Test.QuickCheck.choose (Word16
0, Word16
999)
      Gen (Word16 -> SLCANCounters) -> Gen Word16 -> Gen SLCANCounters
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
Test.QuickCheck.choose (Word16
0, Word16
999)

data SLCANError
  = SLCANError_Ack
  | SLCANError_Bit0
  | SLCANError_Bit1
  | SLCANError_CRC
  | SLCANError_Form
  | SLCANError_RxOverrun
  | SLCANError_TxOverrun
  | SLCANError_Stuff
  deriving (SLCANError
SLCANError -> SLCANError -> Bounded SLCANError
forall a. a -> a -> Bounded a
$cminBound :: SLCANError
minBound :: SLCANError
$cmaxBound :: SLCANError
maxBound :: SLCANError
Bounded, SLCANError -> SLCANError -> Bool
(SLCANError -> SLCANError -> Bool)
-> (SLCANError -> SLCANError -> Bool) -> Eq SLCANError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANError -> SLCANError -> Bool
== :: SLCANError -> SLCANError -> Bool
$c/= :: SLCANError -> SLCANError -> Bool
/= :: SLCANError -> SLCANError -> Bool
Eq, Int -> SLCANError
SLCANError -> Int
SLCANError -> [SLCANError]
SLCANError -> SLCANError
SLCANError -> SLCANError -> [SLCANError]
SLCANError -> SLCANError -> SLCANError -> [SLCANError]
(SLCANError -> SLCANError)
-> (SLCANError -> SLCANError)
-> (Int -> SLCANError)
-> (SLCANError -> Int)
-> (SLCANError -> [SLCANError])
-> (SLCANError -> SLCANError -> [SLCANError])
-> (SLCANError -> SLCANError -> [SLCANError])
-> (SLCANError -> SLCANError -> SLCANError -> [SLCANError])
-> Enum SLCANError
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SLCANError -> SLCANError
succ :: SLCANError -> SLCANError
$cpred :: SLCANError -> SLCANError
pred :: SLCANError -> SLCANError
$ctoEnum :: Int -> SLCANError
toEnum :: Int -> SLCANError
$cfromEnum :: SLCANError -> Int
fromEnum :: SLCANError -> Int
$cenumFrom :: SLCANError -> [SLCANError]
enumFrom :: SLCANError -> [SLCANError]
$cenumFromThen :: SLCANError -> SLCANError -> [SLCANError]
enumFromThen :: SLCANError -> SLCANError -> [SLCANError]
$cenumFromTo :: SLCANError -> SLCANError -> [SLCANError]
enumFromTo :: SLCANError -> SLCANError -> [SLCANError]
$cenumFromThenTo :: SLCANError -> SLCANError -> SLCANError -> [SLCANError]
enumFromThenTo :: SLCANError -> SLCANError -> SLCANError -> [SLCANError]
Enum, Eq SLCANError
Eq SLCANError =>
(SLCANError -> SLCANError -> Ordering)
-> (SLCANError -> SLCANError -> Bool)
-> (SLCANError -> SLCANError -> Bool)
-> (SLCANError -> SLCANError -> Bool)
-> (SLCANError -> SLCANError -> Bool)
-> (SLCANError -> SLCANError -> SLCANError)
-> (SLCANError -> SLCANError -> SLCANError)
-> Ord SLCANError
SLCANError -> SLCANError -> Bool
SLCANError -> SLCANError -> Ordering
SLCANError -> SLCANError -> SLCANError
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 :: SLCANError -> SLCANError -> Ordering
compare :: SLCANError -> SLCANError -> Ordering
$c< :: SLCANError -> SLCANError -> Bool
< :: SLCANError -> SLCANError -> Bool
$c<= :: SLCANError -> SLCANError -> Bool
<= :: SLCANError -> SLCANError -> Bool
$c> :: SLCANError -> SLCANError -> Bool
> :: SLCANError -> SLCANError -> Bool
$c>= :: SLCANError -> SLCANError -> Bool
>= :: SLCANError -> SLCANError -> Bool
$cmax :: SLCANError -> SLCANError -> SLCANError
max :: SLCANError -> SLCANError -> SLCANError
$cmin :: SLCANError -> SLCANError -> SLCANError
min :: SLCANError -> SLCANError -> SLCANError
Ord, Int -> SLCANError -> ShowS
[SLCANError] -> ShowS
SLCANError -> String
(Int -> SLCANError -> ShowS)
-> (SLCANError -> String)
-> ([SLCANError] -> ShowS)
-> Show SLCANError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANError -> ShowS
showsPrec :: Int -> SLCANError -> ShowS
$cshow :: SLCANError -> String
show :: SLCANError -> String
$cshowList :: [SLCANError] -> ShowS
showList :: [SLCANError] -> ShowS
Show)

instance Arbitrary SLCANError where
  arbitrary :: Gen SLCANError
arbitrary = Gen SLCANError
forall a. (Bounded a, Enum a) => Gen a
Test.QuickCheck.arbitraryBoundedEnum

data SLCANConfig = SLCANConfig
  { SLCANConfig -> SLCANBitrate
slCANConfigBitrate :: SLCANBitrate
  , SLCANConfig -> Bool
slCANConfigResetErrors :: Bool
  , SLCANConfig -> Bool
slCANConfigListenOnly :: Bool
  } deriving (SLCANConfig -> SLCANConfig -> Bool
(SLCANConfig -> SLCANConfig -> Bool)
-> (SLCANConfig -> SLCANConfig -> Bool) -> Eq SLCANConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SLCANConfig -> SLCANConfig -> Bool
== :: SLCANConfig -> SLCANConfig -> Bool
$c/= :: SLCANConfig -> SLCANConfig -> Bool
/= :: SLCANConfig -> SLCANConfig -> Bool
Eq, Eq SLCANConfig
Eq SLCANConfig =>
(SLCANConfig -> SLCANConfig -> Ordering)
-> (SLCANConfig -> SLCANConfig -> Bool)
-> (SLCANConfig -> SLCANConfig -> Bool)
-> (SLCANConfig -> SLCANConfig -> Bool)
-> (SLCANConfig -> SLCANConfig -> Bool)
-> (SLCANConfig -> SLCANConfig -> SLCANConfig)
-> (SLCANConfig -> SLCANConfig -> SLCANConfig)
-> Ord SLCANConfig
SLCANConfig -> SLCANConfig -> Bool
SLCANConfig -> SLCANConfig -> Ordering
SLCANConfig -> SLCANConfig -> SLCANConfig
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 :: SLCANConfig -> SLCANConfig -> Ordering
compare :: SLCANConfig -> SLCANConfig -> Ordering
$c< :: SLCANConfig -> SLCANConfig -> Bool
< :: SLCANConfig -> SLCANConfig -> Bool
$c<= :: SLCANConfig -> SLCANConfig -> Bool
<= :: SLCANConfig -> SLCANConfig -> Bool
$c> :: SLCANConfig -> SLCANConfig -> Bool
> :: SLCANConfig -> SLCANConfig -> Bool
$c>= :: SLCANConfig -> SLCANConfig -> Bool
>= :: SLCANConfig -> SLCANConfig -> Bool
$cmax :: SLCANConfig -> SLCANConfig -> SLCANConfig
max :: SLCANConfig -> SLCANConfig -> SLCANConfig
$cmin :: SLCANConfig -> SLCANConfig -> SLCANConfig
min :: SLCANConfig -> SLCANConfig -> SLCANConfig
Ord, Int -> SLCANConfig -> ShowS
[SLCANConfig] -> ShowS
SLCANConfig -> String
(Int -> SLCANConfig -> ShowS)
-> (SLCANConfig -> String)
-> ([SLCANConfig] -> ShowS)
-> Show SLCANConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SLCANConfig -> ShowS
showsPrec :: Int -> SLCANConfig -> ShowS
$cshow :: SLCANConfig -> String
show :: SLCANConfig -> String
$cshowList :: [SLCANConfig] -> ShowS
showList :: [SLCANConfig] -> ShowS
Show)

instance Default SLCANConfig where
  def :: SLCANConfig
def =
    SLCANConfig
    { slCANConfigBitrate :: SLCANBitrate
slCANConfigBitrate = SLCANBitrate
forall a. Default a => a
def
    , slCANConfigResetErrors :: Bool
slCANConfigResetErrors = Bool
False
    , slCANConfigListenOnly :: Bool
slCANConfigListenOnly = Bool
False
    }