module Data.MessagePack.Iteratee(
getI,
enumHandleNonBlocking,
parserToIteratee,
) where
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.Attoparsec as A
import qualified Data.ByteString as B
import qualified Data.Iteratee as I
import System.IO
import Data.MessagePack.Parser
getI :: (Monad m, ObjectGet a) => I.Iteratee B.ByteString m a
getI = parserToIteratee get
enumHandleNonBlocking :: MonadIO m => Int -> Handle -> I.Enumerator B.ByteString m a
enumHandleNonBlocking bufSize h =
I.enumFromCallback $ readSome bufSize h
readSome :: MonadIO m => Int -> Handle -> m (Either SomeException (Bool, B.ByteString))
readSome bufSize h = liftIO $ do
ebs <- try $ hGetSome bufSize h
case ebs of
Left exc ->
return $ Left (exc :: SomeException)
Right bs | B.null bs ->
return $ Right (False, B.empty)
Right bs ->
return $ Right (True, bs)
hGetSome :: Int -> Handle -> IO B.ByteString
hGetSome bufSize h = do
bs <- B.hGetNonBlocking h bufSize
if B.null bs
then do
hd <- B.hGet h 1
if B.null hd
then do
return B.empty
else do
rest <- B.hGetNonBlocking h (bufSize 1)
return $ B.cons (B.head hd) rest
else do
return bs
parserToIteratee :: Monad m => A.Parser a -> I.Iteratee B.ByteString m a
parserToIteratee p = I.icont (itr (A.parse p)) Nothing
where
itr pcont s = case s of
I.EOF _ ->
I.throwErr (I.setEOF s)
I.Chunk bs ->
case pcont bs of
A.Fail _ _ msg ->
I.throwErr (I.iterStrExc msg)
A.Partial cont ->
I.icont (itr cont) Nothing
A.Done remain ret ->
I.idone ret (I.Chunk remain)