module Data.BinaryCom
(BinaryCom,
binaryCom, binaryCom2H, binaryComBS,
send, flushAfter, receive,
sendPut, receiveGet,
(+|))
where
import System.IO
import Data.IORef
import Control.Monad (when)
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
Bool
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 True
send :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
send b@(BinaryCom _ _ doFlush) val = do
sendPut b . B.put $ val
when doFlush $ flush b
flushAfter :: (MonadIO m) => BinaryCom -> (BinaryCom -> m ()) -> m ()
flushAfter b@(BinaryCom ref hW _) cont = do
cont $ BinaryCom ref hW False
flush b
flush :: (MonadIO m) => BinaryCom -> m ()
flush (BinaryCom _ hW _) = liftIO $ hFlush hW
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
(+|) :: a -> a -> Bool -> a
(+|) t e c = if c then t else e