module Control.Concurrent.Network.Protocol
(
readProtoId
, writeProtoId
, readBinary
, writeBinary
, readByteString
, writeByteString
, slaveID
, numSlaves
, printMsg
, ProtoId(..)
, Equality(..)
) where
import System.IO
import Data.Int
import Data.Binary
import Data.ByteString.Lazy as DBL
import Data.Maybe
import Control.Concurrent.Network.Slave
type MsgLen = Int16
data ProtoId =
NNV
| PNV
| TNV
| PWO
| PMS
| SID
| NSL
deriving (Enum, Show)
instance Binary ProtoId where
put x = put (fromIntegral (fromEnum x)::Int16)
get = (get :: Get Int16) >>= return . toEnum . fromIntegral
data Equality = EQOP | NEQOP deriving Eq
instance Binary Equality where
put EQOP = put (fromIntegral 0::Int16)
put NEQOP = put (fromIntegral 1::Int16)
get = do
g <- (get :: Get Int16)
case g of
0 -> return EQOP
1 -> return NEQOP
readProtoId :: Handle -> IO ProtoId
readProtoId h = hGet h 2 >>= return . decode
writeProtoId :: Handle -> ProtoId -> IO ()
writeProtoId h p = hPut h $ encode p
readByteString :: Handle -> IO ByteString
readByteString h = do
l <- hGet h 2
m <- hGet h $ fromIntegral (decode l::MsgLen)
return m
readBinary :: (Binary a) => Handle -> IO a
readBinary h = readByteString h >>= return . decode
writeByteString :: Handle -> ByteString -> IO ()
writeByteString h bs = let
len = encode (fromIntegral $ DBL.length bs::MsgLen)
in hPut h len >> hPut h bs
writeBinary :: (Binary a) => Handle -> a -> IO ()
writeBinary h a = return (encode a) >>= writeByteString h
slaveID :: NCContext -> IO Int
slaveID nc = writeProtoId (hdl nc) SID >> readBinary (hdl nc)
printMsg :: NCContext -> String -> IO ()
printMsg nc msg = writeProtoId (hdl nc) PMS >> writeBinary (hdl nc) msg
numSlaves :: NCContext -> IO Int
numSlaves nc = writeProtoId (hdl nc) NSL >> readBinary (hdl nc)