{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

module Network.SLCAN.Builder
  ( buildSLCANMessage
  ) where

import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Set (Set)
import Network.CAN.Types (CANArbitrationField(..), CANMessage(..))
import Network.SLCAN.Types
  ( SLCANMessage(..)
  , SLCANControl(..)
  , SLCANState(..)
  , SLCANCounters(..)
  , SLCANError(..)
  )
import qualified Data.Bits
import qualified Data.Set
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Builder

slCANBuilder
  :: SLCANMessage
  -> Builder
slCANBuilder :: SLCANMessage -> Builder
slCANBuilder SLCANMessage
slcanMsg =
  case SLCANMessage
slcanMsg of
    SLCANMessage_Control SLCANControl
ctrlMsg -> SLCANControl -> Builder
slCANControlBuilder SLCANControl
ctrlMsg
    SLCANMessage_Data CANMessage
canMsg -> CANMessage -> Builder
slCANDataBuilder CANMessage
canMsg
    SLCANMessage_State SLCANState
state SLCANCounters
counters  -> SLCANState -> SLCANCounters -> Builder
slCANStateBuilder SLCANState
state SLCANCounters
counters
    SLCANMessage_Error Set SLCANError
errs -> Set SLCANError -> Builder
slCANErrorBuilder Set SLCANError
errs
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Data.ByteString.Builder.char7 Char
'\r'

slCANControlBuilder
  :: SLCANControl
  -> Builder
slCANControlBuilder :: SLCANControl -> Builder
slCANControlBuilder SLCANControl
SLCANControl_Open =
  Char -> Builder
Data.ByteString.Builder.char7 Char
'O'
slCANControlBuilder SLCANControl
SLCANControl_Close =
  Char -> Builder
Data.ByteString.Builder.char7 Char
'C'
slCANControlBuilder (SLCANControl_Bitrate SLCANBitrate
bitrate) =
     Char -> Builder
Data.ByteString.Builder.char7 Char
'S'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
Data.ByteString.Builder.intDec
      (SLCANBitrate -> Int
forall a. Enum a => a -> Int
fromEnum SLCANBitrate
bitrate)
slCANControlBuilder SLCANControl
SLCANControl_ResetErrors =
  Char -> Builder
Data.ByteString.Builder.char7 Char
'F'
slCANControlBuilder SLCANControl
SLCANControl_ListenOnly =
  Char -> Builder
Data.ByteString.Builder.char7 Char
'L'

slCANDataBuilder
  :: CANMessage
  -> Builder
slCANDataBuilder :: CANMessage -> Builder
slCANDataBuilder CANMessage{[Word8]
CANArbitrationField
canMessageArbitrationField :: CANArbitrationField
canMessageData :: [Word8]
canMessageData :: CANMessage -> [Word8]
canMessageArbitrationField :: CANMessage -> CANArbitrationField
..} =
     CANArbitrationField -> Builder
arbitrationId CANArbitrationField
canMessageArbitrationField
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Data.ByteString.Builder.word8Hex
      (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)
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      ((Word8 -> Builder) -> [Word8] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map
         Word8 -> Builder
Data.ByteString.Builder.word8HexFixed
         [Word8]
canMessageData
      )

arbitrationId
  :: CANArbitrationField
  -> Builder
arbitrationId :: CANArbitrationField -> Builder
arbitrationId CANArbitrationField{Bool
Word32
canArbitrationFieldID :: Word32
canArbitrationFieldExtended :: Bool
canArbitrationFieldRTR :: Bool
canArbitrationFieldRTR :: CANArbitrationField -> Bool
canArbitrationFieldExtended :: CANArbitrationField -> Bool
canArbitrationFieldID :: CANArbitrationField -> Word32
..} =
     Char -> Builder
Data.ByteString.Builder.char7
       (case ( Bool
canArbitrationFieldExtended
             , Bool
canArbitrationFieldRTR
             )
        of
         (Bool
False, Bool
False) -> Char
't'
         (Bool
False, Bool
True)  -> Char
'r'
         (Bool
True, Bool
False)  -> Char
'T'
         (Bool
True, Bool
True)   -> Char
'R'
       )
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
canArbitrationFieldExtended
      then Word32 -> Builder
Data.ByteString.Builder.word32HexFixed
      else
        (\Word32
word11 ->
           Word8 -> Builder
Data.ByteString.Builder.word8Hex
            (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
word11 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
8))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Data.ByteString.Builder.word8HexFixed
            (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
word11)
        )
     )
     Word32
canArbitrationFieldID

slCANStateBuilder
  :: SLCANState
  -> SLCANCounters
  -> Builder
slCANStateBuilder :: SLCANState -> SLCANCounters -> Builder
slCANStateBuilder SLCANState
state SLCANCounters{Word16
slCANCountersRxErrors :: Word16
slCANCountersTxErrors :: Word16
slCANCountersTxErrors :: SLCANCounters -> Word16
slCANCountersRxErrors :: SLCANCounters -> Word16
..} =
     Char -> Builder
Data.ByteString.Builder.char7 Char
's'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Data.ByteString.Builder.char7
      (case SLCANState
state of
         SLCANState
SLCANState_Active -> Char
'a'
         SLCANState
SLCANState_Warning -> Char
'w'
         SLCANState
SLCANState_Passive -> Char
'p'
         SLCANState
SLCANState_BusOff -> Char
'b'
      )
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Dec3 Word16
slCANCountersTxErrors
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Dec3 Word16
slCANCountersRxErrors
  where
    -- encode as 3 bytes (maximum of 999 and zero padded)
    word16Dec3 :: Word16 -> Builder
word16Dec3 Word16
x =
           (case Word16
x of
              Word16
_ | Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
10 -> String -> Builder
Data.ByteString.Builder.string7 String
"00"
              Word16
_ | Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
100 -> Char -> Builder
Data.ByteString.Builder.char7 Char
'0'
              Word16
_ | Bool
otherwise -> Builder
forall a. Monoid a => a
mempty
           )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
Data.ByteString.Builder.word16Dec
            (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
999 Word16
x)

slCANErrorBuilder
  :: Set SLCANError
  -> Builder
slCANErrorBuilder :: Set SLCANError -> Builder
slCANErrorBuilder Set SLCANError
errs =
     Char -> Builder
Data.ByteString.Builder.char7 Char
'e'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Data.ByteString.Builder.word8Hex
      (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Set SLCANError -> Int
forall a. Set a -> Int
Data.Set.size Set SLCANError
errs)
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      ((SLCANError -> Builder) -> [SLCANError] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map
         ( Char -> Builder
Data.ByteString.Builder.char7
         (Char -> Builder) -> (SLCANError -> Char) -> SLCANError -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
             SLCANError
SLCANError_Ack -> Char
'a'
             SLCANError
SLCANError_Bit0 -> Char
'b'
             SLCANError
SLCANError_Bit1 -> Char
'B'
             SLCANError
SLCANError_CRC -> Char
'c'
             SLCANError
SLCANError_Form -> Char
'f'
             SLCANError
SLCANError_RxOverrun -> Char
'o'
             SLCANError
SLCANError_TxOverrun -> Char
'O'
             SLCANError
SLCANError_Stuff -> Char
's'
         )
         ([SLCANError] -> [Builder]) -> [SLCANError] -> [Builder]
forall a b. (a -> b) -> a -> b
$ Set SLCANError -> [SLCANError]
forall a. Set a -> [a]
Data.Set.toList
             Set SLCANError
errs
      )

buildSLCANMessage
  :: SLCANMessage
  -> ByteString
buildSLCANMessage :: SLCANMessage -> ByteString
buildSLCANMessage =
   LazyByteString -> ByteString
Data.ByteString.Lazy.toStrict
 (LazyByteString -> ByteString)
-> (SLCANMessage -> LazyByteString) -> SLCANMessage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
Data.ByteString.Builder.toLazyByteString
 (Builder -> LazyByteString)
-> (SLCANMessage -> Builder) -> SLCANMessage -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SLCANMessage -> Builder
slCANBuilder