module Data.BinaryCom
(BinaryCom,
binaryCom, binaryCom2H, binaryComBS,
send, flush, sendFlush, receive,
sendPut, receiveGet)
where
import System.IO
import Data.IORef
import Control.Monad.Trans
import qualified Data.ByteString.Lazy as L
import qualified Data.Binary as B
import qualified Data.Binary.Get as B
import qualified Data.Binary.Put as B
data BinaryCom = BinaryCom (IORef L.ByteString)
Handle
binaryCom :: (MonadIO m) => Handle -> m BinaryCom
binaryCom h = binaryCom2H h h
binaryCom2H :: (MonadIO m) =>
Handle
-> Handle
-> m BinaryCom
binaryCom2H hR hW = do
inp <- liftIO $ L.hGetContents hR
binaryComBS inp hW
binaryComBS :: (MonadIO m) =>
L.ByteString
-> Handle
-> m BinaryCom
binaryComBS inp hW = liftIO $ do
ref <- newIORef inp
return $ BinaryCom ref hW
send :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
send b = sendPut b . B.put
flush :: (MonadIO m) => BinaryCom -> m ()
flush (BinaryCom _ hW) = liftIO $ hFlush hW
sendFlush :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
sendFlush b v = send b v >> flush b
receive :: (B.Binary a, MonadIO m) => BinaryCom -> m a
receive b = receiveGet b B.get
sendPut :: (MonadIO m) => BinaryCom -> B.Put -> m ()
sendPut (BinaryCom _ hW) putAction = liftIO $
L.hPut hW $ B.runPut putAction
receiveGet :: (MonadIO m) => BinaryCom -> B.Get a -> m a
receiveGet (BinaryCom ref _) getAction = liftIO $ do
inp <- readIORef ref
let (val, inpRest, _) = B.runGetState getAction inp 0
writeIORef ref inpRest
return val