module Data.BinaryCom
(BinaryCom, binaryCom, binaryCom', binaryCom'',
send, flush, sendFlush, receive)
where
import System.IO
import Data.IORef
import Control.Monad (liftM)
import Control.Monad.Trans (MonadIO(..))
import qualified Data.ByteString.Lazy as L
import qualified Data.Binary as B
import qualified Data.Binary.Get as B
newtype BinaryCom = BinaryCom (IORef (L.ByteString, Handle))
binaryCom :: (MonadIO m) => Handle -> m BinaryCom
binaryCom h = binaryCom' h h
binaryCom' :: (MonadIO m) => Handle -> Handle -> m BinaryCom
binaryCom' hR hW = do
inp <- liftIO $ L.hGetContents hR
binaryCom'' inp hW
binaryCom'' :: (MonadIO m) => L.ByteString -> Handle -> m BinaryCom
binaryCom'' inp hW = liftIO $
liftM BinaryCom $ newIORef (inp, hW)
send :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
send (BinaryCom ref) val = liftIO $ do
(_, h) <- readIORef ref
L.hPut h (B.encode val)
flush :: (MonadIO m) => BinaryCom -> m ()
flush (BinaryCom ref) = liftIO $ do
(_, h) <- readIORef ref
hFlush h
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 (BinaryCom ref) = liftIO $ do
(inp, h) <- readIORef ref
let (val, inpRest, _) = B.runGetState B.get inp 0
writeIORef ref (inpRest, h)
return val