binary-communicator-1.0: Data/BinaryCom.hs

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


-- | @BinaryCom@ type
newtype BinaryCom = BinaryCom (IORef (L.ByteString, Handle))

-- | 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 = binaryCom' h h

-- | Creates a @BinaryCom@ from two @Handle@s: one for reading, one for writing
binaryCom' :: (MonadIO m) => Handle -> Handle -> m BinaryCom
binaryCom' hR hW = do
  inp <- liftIO $ L.hGetContents hR
  binaryCom'' inp hW

-- | Creates a @BinaryCom@ from a lazy @ByteString@ (for reading) and a @Handle@ (for writing)
binaryCom'' :: (MonadIO m) => L.ByteString -> Handle -> m BinaryCom
binaryCom'' inp hW = liftIO $
  liftM BinaryCom $ newIORef (inp, hW)

-- | Sends a serializable value through a @BinaryCom@
send :: (B.Binary a, MonadIO m) => BinaryCom -> a -> m ()
send (BinaryCom ref) val = liftIO $ do
  (_, h) <- readIORef ref
  L.hPut h (B.encode val)

-- | Flushes a @BinaryCom@. Do not forget to do this after sending!
flush :: (MonadIO m) => BinaryCom -> m ()
flush (BinaryCom ref) = liftIO $ do
  (_, h) <- readIORef ref
  hFlush h

-- | 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 (BinaryCom ref) = liftIO $ do
  (inp, h) <- readIORef ref
  let (val, inpRest, _) = B.runGetState B.get inp 0
  writeIORef ref (inpRest, h)
  return val