module Control.Monad.NetworkProtocol.Conduit where

import Data.Conduit as DC
import Data.Conduit.Cereal
import Data.Conduit.Binary as CB
import Data.ByteString.Lazy (toStrict)
import qualified Data.Conduit.Internal as DCI
import Control.Monad.Catch
import Data.Serialize
import Data.ByteString as BS
import Data.ByteString.Lazy (toStrict)

import Control.Monad.NetworkProtocol

conduitProtocol :: (Monad m, MonadThrow m) => Protocol e b
                  -> ConduitM ByteString ByteString m (Either e b)
conduitProtocol = run where
  run (Recv x f) = (fmap toStrict $ CB.take x) >>= run . f
  run (Send bs f) = yield bs >> run f
  run (RecvMsg f) = (sinkGet get) >>= run . f
  run (SendMsg msg f) = yield (encode msg) >> run f
  run (Finalize r) = return $ Right r
  run (Exception e) = return $ Left e

fuseProtocol src dest protocol
  = src $$++ (fmap fst $ fuseBoth (conduitProtocol protocol) dest)
