module Network.Linx.Gateway.Types
( Status (..)
, Length (..)
, Index (..)
, SigNo (..)
, Version (..)
, Flags (..)
, CString (..)
, User (..)
, Pid (..)
, Timeout (..)
, Attref (..)
, mkCString
, cstrlen
, toLength
, asInt
) where
import Control.Applicative ((<$>))
import Data.Binary
import Data.Binary.Get (getLazyByteStringNul)
import Data.Binary.Put (putLazyByteString)
import GHC.Generics
import qualified Data.ByteString.Lazy.Char8 as LBS
import Network.Linx.Gateway.BinaryInt32 (Int32, getInt32, putInt32)
data Status =
Success
| Error
deriving (Show, Eq)
newtype Length = Length Int32
deriving (Show, Eq, Generic)
newtype Index = Index Int32
deriving (Show, Eq, Generic)
newtype SigNo = SigNo Int32
deriving (Show, Eq, Generic)
data Version =
V100
| Version !Int32
deriving (Show, Eq)
data Flags =
BigEndian
| LittleEndian
| Flags !Int32
deriving (Show, Eq)
newtype CString = CString LBS.ByteString
deriving (Show, Eq)
data User = AlwaysZero
deriving (Show, Eq)
newtype Pid = Pid Int32
deriving (Show, Eq, Generic)
data Timeout =
Infinity
| Timeout Int32
deriving (Eq, Show)
newtype Attref = Attref Int32
deriving (Show, Eq, Generic)
instance Binary Length
instance Binary Index
instance Binary SigNo
instance Binary Pid
instance Binary Attref
instance Binary Status where
get = do
value <- getInt32
return $
case value of
0 -> Success
_ -> Error
put Success = putInt32 0
put Error = putInt32 (1)
instance Binary Version where
get = do
value <- getInt32
return $
case value of
100 -> V100
_ -> Version value
put V100 = putInt32 100
put (Version value) = put value
instance Binary Flags where
get = do
value <- getInt32
return $
case value of
0 -> BigEndian
1 -> LittleEndian
_ -> Flags value
put BigEndian = putInt32 0
put LittleEndian = putInt32 1
put (Flags value) = put value
instance Binary CString where
get = CString <$> getLazyByteStringNul
put (CString lbs) = putLazyByteString lbs >> putWord8 0
instance Binary User where
get = do
value <- getInt32
return $
case value of
0 -> AlwaysZero
_ -> error $ "Unexpected user value: " ++ show value
put AlwaysZero = putInt32 0
instance Binary Timeout where
get = do
value <- getInt32
return $
case value of
(1) -> Infinity
_ -> Timeout value
put Infinity = putInt32 (1)
put (Timeout value) = put value
mkCString :: String -> CString
mkCString = CString . LBS.pack
cstrlen :: CString -> Length
cstrlen (CString lbs) = toLength $ LBS.length lbs + 1
toLength :: Integral a => a -> Length
toLength = Length . fromIntegral
asInt :: Num a => Length -> a
asInt (Length l) = fromIntegral l