-- |
-- Binary Communicator
--
-- This module provides the datatype BinaryCom, which enables you
-- to easily send and receive data to and from a binary source.
-- The transmitted data can be an instance of the 'Binary' class,
-- or you can provide your own Put and Get actions to serialize
-- and parse the binary stream.
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
-- | 'BinaryCom' type
data BinaryCom = BinaryCom (IORef L.ByteString) -- For reading
Handle -- For writing
-- | Creates a 'BinaryCom' from a 'Handle' opened for both reading and writing.
-- Be careful not to use the handle afterwards
binaryCom :: (MonadIO m) => Handle -> m BinaryCom
binaryCom h = binaryCom2H h h
-- | Creates a 'BinaryCom' from two 'Handle's: one for reading, one for writing
binaryCom2H :: (MonadIO m) =>
Handle -- ^ For reading
-> Handle -- ^ For writing
-> m BinaryCom -- ^ New 'BinaryCom'
binaryCom2H hR hW = do
inp <- liftIO $ L.hGetContents hR
binaryComBS inp hW
-- | Creates a 'BinaryCom' from a lazy 'L.ByteString' (for reading) and a 'Handle' (for writing)
binaryComBS :: (MonadIO m) =>
L.ByteString -- ^ For reading
-> Handle -- ^ For writing
-> m BinaryCom -- ^ New 'BinaryCom'
binaryComBS inp hW = liftIO $ do
ref <- newIORef inp
return $ BinaryCom ref hW
-- | Sends a serializable value through a 'BinaryCom'
send :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
send b = sendPut b . B.put
-- | Flushes a 'BinaryCom'. Do not forget to do this after sending!
flush :: (MonadIO m) => BinaryCom -> m ()
flush (BinaryCom _ hW) = liftIO $ hFlush hW
-- | Shortcut for sending a value and flushing the 'BinaryCom'
sendFlush :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
sendFlush b v = send b v >> flush b
-- | Receives a serializable value through a 'BinaryCom'
receive :: (B.Binary a, MonadIO m) => BinaryCom -> m a
receive b = receiveGet b B.get
-- | Runs a 'B.Put' monad and sends its result
sendPut :: (MonadIO m) => BinaryCom -> B.Put -> m ()
sendPut (BinaryCom _ hW) putAction = liftIO $
L.hPut hW $ B.runPut putAction
-- | Receives a value. Runs a 'B.Get' monad to parse it
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