mirror of
https://github.com/msgpack/msgpack-c.git
synced 2025-03-20 13:33:51 +01:00
haskell: add Iteratee interface
This commit is contained in:
parent
9e50ba6ec6
commit
b75db110dc
@ -33,3 +33,4 @@ Library
|
|||||||
Data.MessagePack.Object
|
Data.MessagePack.Object
|
||||||
Data.MessagePack.Put
|
Data.MessagePack.Put
|
||||||
Data.MessagePack.Parser
|
Data.MessagePack.Parser
|
||||||
|
Data.MessagePack.Iteratee
|
||||||
|
@ -16,6 +16,7 @@ module Data.MessagePack(
|
|||||||
module Data.MessagePack.Object,
|
module Data.MessagePack.Object,
|
||||||
module Data.MessagePack.Put,
|
module Data.MessagePack.Put,
|
||||||
module Data.MessagePack.Parser,
|
module Data.MessagePack.Parser,
|
||||||
|
module Data.MessagePack.Iteratee,
|
||||||
|
|
||||||
-- * Simple functions of Pack and Unpack
|
-- * Simple functions of Pack and Unpack
|
||||||
pack,
|
pack,
|
||||||
@ -30,6 +31,9 @@ module Data.MessagePack(
|
|||||||
unpackFromString,
|
unpackFromString,
|
||||||
unpackFromHandle,
|
unpackFromHandle,
|
||||||
unpackFromFile,
|
unpackFromFile,
|
||||||
|
unpackFromStringI,
|
||||||
|
unpackFromHandleI,
|
||||||
|
unpackFromFileI,
|
||||||
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -47,6 +51,7 @@ import System.IO
|
|||||||
import Data.MessagePack.Object
|
import Data.MessagePack.Object
|
||||||
import Data.MessagePack.Put
|
import Data.MessagePack.Put
|
||||||
import Data.MessagePack.Parser
|
import Data.MessagePack.Parser
|
||||||
|
import Data.MessagePack.Iteratee
|
||||||
|
|
||||||
bufferSize :: Int
|
bufferSize :: Int
|
||||||
bufferSize = 4 * 1024
|
bufferSize = 4 * 1024
|
||||||
@ -67,7 +72,7 @@ pack = packToString . put
|
|||||||
-- | Unpack MessagePack string to Haskell data.
|
-- | Unpack MessagePack string to Haskell data.
|
||||||
unpack :: (ObjectGet a, IsByteString s) => s -> a
|
unpack :: (ObjectGet a, IsByteString s) => s -> a
|
||||||
unpack bs =
|
unpack bs =
|
||||||
runIdentity $ I.run $ I.joinIM $ I.enumPure1Chunk (toBS bs) (parserToIteratee get)
|
runIdentity $ I.run $ I.joinIM $ I.enumPure1Chunk (toBS bs) getI
|
||||||
|
|
||||||
-- TODO: tryUnpack
|
-- TODO: tryUnpack
|
||||||
|
|
||||||
@ -86,32 +91,32 @@ packToFile path = L.writeFile path . packToString
|
|||||||
-- | Unpack from ByteString
|
-- | Unpack from ByteString
|
||||||
unpackFromString :: (Monad m, IsByteString s) => s -> A.Parser a -> m a
|
unpackFromString :: (Monad m, IsByteString s) => s -> A.Parser a -> m a
|
||||||
unpackFromString bs =
|
unpackFromString bs =
|
||||||
I.run . I.joinIM . I.enumPure1Chunk (toBS bs) . parserToIteratee
|
unpackFromStringI bs . parserToIteratee
|
||||||
|
|
||||||
-- | Unpack from Handle
|
-- | Unpack from Handle
|
||||||
unpackFromHandle :: CIO.MonadCatchIO m => Handle -> A.Parser a -> m a
|
unpackFromHandle :: CIO.MonadCatchIO m => Handle -> A.Parser a -> m a
|
||||||
unpackFromHandle h =
|
unpackFromHandle h =
|
||||||
I.run . I.joinIM . I.enumHandle bufferSize h . parserToIteratee
|
unpackFromHandleI h .parserToIteratee
|
||||||
|
|
||||||
-- | Unpack from File
|
-- | Unpack from File
|
||||||
unpackFromFile :: CIO.MonadCatchIO m => FilePath -> A.Parser a -> m a
|
unpackFromFile :: CIO.MonadCatchIO m => FilePath -> A.Parser a -> m a
|
||||||
unpackFromFile path p =
|
unpackFromFile path =
|
||||||
|
unpackFromFileI path . parserToIteratee
|
||||||
|
|
||||||
|
-- | Iteratee interface to unpack from ByteString
|
||||||
|
unpackFromStringI :: (Monad m, IsByteString s) => s -> I.Iteratee B.ByteString m a -> m a
|
||||||
|
unpackFromStringI bs =
|
||||||
|
I.run . I.joinIM . I.enumPure1Chunk (toBS bs)
|
||||||
|
|
||||||
|
-- | Iteratee interface to unpack from Handle
|
||||||
|
unpackFromHandleI :: CIO.MonadCatchIO m => Handle -> I.Iteratee B.ByteString m a -> m a
|
||||||
|
unpackFromHandleI h =
|
||||||
|
I.run . I.joinIM . I.enumHandle bufferSize h
|
||||||
|
|
||||||
|
-- | Iteratee interface to unpack from File
|
||||||
|
unpackFromFileI :: CIO.MonadCatchIO m => FilePath -> I.Iteratee B.ByteString m a -> m a
|
||||||
|
unpackFromFileI path p =
|
||||||
CIO.bracket
|
CIO.bracket
|
||||||
(liftIO $ openBinaryFile path ReadMode)
|
(liftIO $ openBinaryFile path ReadMode)
|
||||||
(liftIO . hClose)
|
(liftIO . hClose)
|
||||||
(flip unpackFromHandle p)
|
(flip unpackFromHandleI p)
|
||||||
|
|
||||||
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)
|
|
||||||
|
46
haskell/src/Data/MessagePack/Iteratee.hs
Normal file
46
haskell/src/Data/MessagePack/Iteratee.hs
Normal file
@ -0,0 +1,46 @@
|
|||||||
|
--------------------------------------------------------------------
|
||||||
|
-- |
|
||||||
|
-- Module : Data.MessagePack.Iteratee
|
||||||
|
-- Copyright : (c) Hideyuki Tanaka, 2009-2010
|
||||||
|
-- License : BSD3
|
||||||
|
--
|
||||||
|
-- Maintainer: tanaka.hideyuki@gmail.com
|
||||||
|
-- Stability : experimental
|
||||||
|
-- Portability: portable
|
||||||
|
--
|
||||||
|
-- MessagePack Deserializer interface to @Data.Iteratee@
|
||||||
|
--
|
||||||
|
--------------------------------------------------------------------
|
||||||
|
|
||||||
|
module Data.MessagePack.Iteratee(
|
||||||
|
-- * Iteratee version of deserializer
|
||||||
|
getI,
|
||||||
|
-- * Convert Parser to Iteratee
|
||||||
|
parserToIteratee,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Attoparsec as A
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.Iteratee as I
|
||||||
|
|
||||||
|
import Data.MessagePack.Parser
|
||||||
|
|
||||||
|
-- | Deserialize a value
|
||||||
|
getI :: (Monad m, ObjectGet a) => I.Iteratee B.ByteString m a
|
||||||
|
getI = parserToIteratee get
|
||||||
|
|
||||||
|
-- | Convert Parser to Iteratee
|
||||||
|
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)
|
Loading…
x
Reference in New Issue
Block a user