module SecondTransfer.MainLoop.Framer(
readNextChunk
,readNextChunkAndContinue
,readLength
,Framer
,LengthCallback
) where
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (MonadIO
)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Conduit
import Data.Monoid (mappend, mempty)
type Framer m = LB.ByteString
-> m B.ByteString
-> Maybe Int
-> m (LB.ByteString, LB.ByteString)
type LengthCallback = B.ByteString -> Maybe Int
readNextChunk :: Monad m =>
LengthCallback
-> B.ByteString
-> m B.ByteString
-> Source m B.ByteString
readNextChunk length_callback input_leftovers gen = do
let
maybe_length = length_callback input_leftovers
readUpTo_ lo the_length | (B.length lo) >= the_length =
return $ B.splitAt the_length lo
readUpTo_ lo the_length = do
frag <- lift gen
readUpTo_ (lo `mappend` frag) the_length
case maybe_length of
Just the_length -> do
(package_bytes, newnewleftovers) <- readUpTo_ input_leftovers the_length
yield package_bytes
readNextChunk length_callback newnewleftovers gen
Nothing -> do
new_fragment <- lift gen
let new_leftovers = input_leftovers `mappend` new_fragment
readNextChunk length_callback new_leftovers gen
readNextChunkAndContinue :: Monad m =>
LengthCallback
-> B.ByteString
-> m B.ByteString
-> m (B.ByteString, B.ByteString)
readNextChunkAndContinue length_callback input_leftovers gen = do
let
maybe_length = length_callback input_leftovers
case maybe_length of
Just the_length -> do
(package_bytes, newnewleftovers) <- readUpTo gen input_leftovers the_length
return (package_bytes, newnewleftovers)
Nothing -> do
new_fragment <- gen
let new_leftovers = input_leftovers `mappend` new_fragment
readNextChunkAndContinue length_callback new_leftovers gen
readUpTo :: Monad m => m B.ByteString -> B.ByteString -> Int -> m (B.ByteString, B.ByteString)
readUpTo _ lo the_length | (B.length lo) >= the_length =
return $ B.splitAt the_length lo
readUpTo gen lo the_length = do
frag <- gen
readUpTo gen (lo `mappend` frag) the_length
readLength :: MonadIO m => Int -> m B.ByteString -> m (B.ByteString, B.ByteString)
readLength the_length gen =
readUpTo_ mempty
where
readUpTo_ lo
| (B.length lo) >= the_length = do
return $ B.splitAt the_length lo
| otherwise = do
frag <- gen
readUpTo_ (lo `mappend` frag)