1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
--------------------------------------------------------------------
-- |
-- Module : Data.MessagePack.Monad
-- Copyright : (c) Hideyuki Tanaka, 2009
-- License : BSD3
--
-- Maintainer: tanaka.hideyuki@gmail.com
-- Stability : experimental
-- Portability: portable
--
-- Monadic Stream Serializers and Deserializers
--
--------------------------------------------------------------------
module Data.MessagePack.Monad(
-- * Classes
MonadPacker(..),
MonadUnpacker(..),
-- * Packer and Unpacker type
PackerT(..),
UnpackerT(..),
-- * Packers
packToString,
packToHandle,
packToFile,
-- * Unpackers
unpackFrom,
unpackFromString,
unpackFromHandle,
unpackFromFile,
) where
import Control.Monad
import Control.Monad.Trans
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import System.IO
import Data.MessagePack.Base hiding (Unpacker)
import qualified Data.MessagePack.Base as Base
import Data.MessagePack.Class
import Data.MessagePack.Feed
class Monad m => MonadPacker m where
-- | Serialize a object
put :: OBJECT a => a -> m ()
class Monad m => MonadUnpacker m where
-- | Deserialize a object
get :: OBJECT a => m a
-- | Serializer Type
newtype PackerT m r = PackerT { runPackerT :: Base.Packer -> m r }
instance Monad m => Monad (PackerT m) where
a >>= b =
PackerT $ \pc -> do
r <- runPackerT a pc
runPackerT (b r) pc
return r =
PackerT $ \_ -> return r
instance MonadTrans PackerT where
lift m = PackerT $ \_ -> m
instance MonadIO m => MonadIO (PackerT m) where
liftIO = lift . liftIO
instance MonadIO m => MonadPacker (PackerT m) where
put v = PackerT $ \pc -> liftIO $ do
pack pc v
-- | Execute given serializer and returns byte sequence.
packToString :: MonadIO m => PackerT m r -> m ByteString
packToString m = do
sb <- liftIO $ newSimpleBuffer
pc <- liftIO $ newPacker sb
runPackerT m pc
liftIO $ simpleBufferData sb
-- | Execcute given serializer and write byte sequence to Handle.
packToHandle :: MonadIO m => Handle -> PackerT m r -> m ()
packToHandle h m = do
sb <- packToString m
liftIO $ BS.hPut h sb
liftIO $ hFlush h
-- | Execute given serializer and write byte sequence to file.
packToFile :: MonadIO m => FilePath -> PackerT m r -> m ()
packToFile p m = do
sb <- packToString m
liftIO $ BS.writeFile p sb
-- | Deserializer type
newtype UnpackerT m r = UnpackerT { runUnpackerT :: Base.Unpacker -> Feeder -> m r }
instance Monad m => Monad (UnpackerT m) where
a >>= b =
UnpackerT $ \up feed -> do
r <- runUnpackerT a up feed
runUnpackerT (b r) up feed
return r =
UnpackerT $ \_ _ -> return r
instance MonadTrans UnpackerT where
lift m = UnpackerT $ \_ _ -> m
instance MonadIO m => MonadIO (UnpackerT m) where
liftIO = lift . liftIO
instance MonadIO m => MonadUnpacker (UnpackerT m) where
get = UnpackerT $ \up feed -> liftIO $ do
resp <- unpackerExecute up
guard $ resp>=0
when (resp==0) $ do
Just bs <- feed
unpackerFeed up bs
resp2 <- unpackerExecute up
guard $ resp2==1
obj <- unpackerData up
freeZone =<< unpackerReleaseZone up
unpackerReset up
let Right r = fromObject obj
return r
-- | Execute deserializer using given feeder.
unpackFrom :: MonadIO m => Feeder -> UnpackerT m r -> m r
unpackFrom f m = do
up <- liftIO $ newUnpacker defaultInitialBufferSize
runUnpackerT m up f
-- | Execute deserializer using given handle.
unpackFromHandle :: MonadIO m => Handle -> UnpackerT m r -> m r
unpackFromHandle h m =
flip unpackFrom m =<< liftIO (feederFromHandle h)
-- | Execute deserializer using given file content.
unpackFromFile :: MonadIO m => FilePath -> UnpackerT m r -> m r
unpackFromFile p m = do
h <- liftIO $ openFile p ReadMode
r <- flip unpackFrom m =<< liftIO (feederFromHandle h)
liftIO $ hClose h
return r
-- | Execute deserializer from given byte sequence.
unpackFromString :: MonadIO m => ByteString -> UnpackerT m r -> m r
unpackFromString bs m = do
flip unpackFrom m =<< liftIO (feederFromString bs)
|
