-- |
-- 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