module Network.Linx.Gateway.Signal
( Signal (..)
, SignalSelector (..)
, SigNo (..)
, PayloadSize (..)
, encode
, decode
) where
import Control.Applicative ((<$>), (<*>))
import Data.Binary
import Data.Binary.Get (getLazyByteString)
import Data.Binary.Put (putLazyByteString)
import qualified Data.ByteString.Lazy as LBS
import Network.Linx.Gateway.Types
import Network.Linx.Gateway.BinaryInt32
import Network.Linx.Gateway.BinaryList
class PayloadSize a where
payloadSize :: a -> Length
data Signal =
Signal { sigNo :: !SigNo
, sigData :: !LBS.ByteString }
| NumericSignal { sigNo :: !SigNo }
| NoSignal
deriving (Eq, Show)
data SignalSelector =
AnySignal
| Cancel
| Sel { selection :: ![SigNo] }
deriving (Eq, Show)
instance PayloadSize Signal where
payloadSize NoSignal = Length 8
payloadSize NumericSignal {} = Length 8
payloadSize sig@Signal {} =
let len = LBS.length $ sigData sig
in toLength $ 8 + len
instance PayloadSize SignalSelector where
payloadSize AnySignal = Length 8
payloadSize Cancel = Length 8
payloadSize sel@Sel {} =
let len = length $ selection sel
in toLength $ 8 + len * 4
instance Binary Signal where
get = do
len <- asInt <$> get
case len of
0 -> getInt32 >> return NoSignal
4 -> NumericSignal <$> get
_ -> Signal <$> get <*> getLazyByteString (len 4)
put NoSignal = putInt32 0 >> putInt32 0
put (NumericSignal sigNo') = putInt32 4 >> put sigNo'
put (Signal sigNo' sigData') =
let len = toLength $ LBS.length sigData' + 4
in put len >> put sigNo' >> putLazyByteString sigData'
instance Binary SignalSelector where
get = do
len <- asInt <$> get
case len :: Int32 of
0 -> getInt32 >> return Cancel
1 -> getInt32 >> return AnySignal
_ -> get >>= \n -> Sel <$> getList n
put AnySignal = putInt32 1 >> putInt32 0
put Cancel = putInt32 0 >> putInt32 0
put sel@Sel {}
| selection sel == [] = error "Cannot encode empty selector list"
| otherwise = do
let len = length (selection sel)
len' = toLength (len + 1)
len'' = toLength len
put (len') >> put len'' >> putList (selection sel)