cereal-plus 0.3.1 → 0.3.2

raw patch · 4 files changed

+64/−22 lines, 4 filesdep +layers

Dependencies added: layers

Files

• cereal-plus.cabal +14/−9
• src/CerealPlus/Deserialize.hs +27/−3
• src/CerealPlus/Prelude.hs +0/−9
• src/CerealPlus/Serialize.hs +23/−1

@@ -1,16 +1,16 @@ name:   cereal-plus version:-  0.3.1+  0.3.2 synopsis:-  Extended serialization library on top of "cereal".+  An extended serialization library on top of "cereal" description:-  Provides non-orphan instances for an extended range of types.-  Provides transformer types and support for mutable data.-  Reapproaches the naming conventions of "cereal" library.+  Provides non-orphan instances for an extended range of types, +  transformer types and support for mutable data,+  while reapproaching the naming conventions of \"cereal\" library. -  For a streaming frontend over this library see "pipes-cereal-plus":-  <http://hackage.haskell.org/package/pipes-cereal-plus>+  For a streaming frontend over this library see +  <http://hackage.haskell.org/package/pipes-cereal-plus "pipes-cereal-plus"> license:   MIT license-file:@@ -50,8 +50,11 @@   other-modules:     CerealPlus.Prelude   build-depends:+    -- Serialization:     cereal == 0.4.*,-    errors,+    -- Concurrency:+    stm,+    -- Data:     time,     hashable,     hashtables,@@ -61,7 +64,9 @@     containers,     text,     bytestring,-    stm,+    -- Control:+    layers == 0.1.*,+    errors,     mtl,     base >= 4.5 && < 5   default-extensions:

@@ -12,10 +12,14 @@  import CerealPlus.Prelude import qualified Data.Serialize.Get as Cereal+import qualified Control.Monad.Layer as Layers   -- | A deserialization monad transformer. -newtype Deserialize m a = Deserialize { runPartial :: ByteString -> m (Result m a) }+newtype Deserialize m a = Deserialize { +  -- | Run on a chunk of data and get a partial result.+  runPartial :: ByteString -> m (Result m a) +}  instance (Monad m) => Monad (Deserialize m) where   Deserialize runA >>= aToDeserializeTB = Deserialize $ \bs -> runA bs >>= aToMB where@@ -38,13 +42,32 @@ instance (Monad m) => Functor (Deserialize m) where   fmap = liftM +instance (Monad m) => Layers.MonadTransFunctor (Deserialize m) where+  transMap = mapBase +instance (Monad m) => Layers.MonadTrans (Deserialize m) where+  type Outer (Deserialize m) = Deserialize+  transInvmap = const . Layers.transMap++instance (Monad m) => Layers.MonadLayerFunctor (Deserialize m) where+  layerMap = Layers.transMap++instance (Monad m) => Layers.MonadLayer (Deserialize m) where+  type Inner (Deserialize m) = m+  layerInvmap = const . Layers.layerMap+  layer = lift+++-- | A partial result of deserialization. data Result m a = +  -- | A message describing the deserialization failure and a remaining chunk.   Fail Text ByteString |+  -- | A continuation function, which should be supplied with the next chunk.   Partial (ByteString -> m (Result m a)) |+  -- | A deserialized data structure and a remaining chunk.   Done a ByteString -+-- | Run a `Cereal.Get` action of the \"cereal\" library. liftGet :: Monad m => Cereal.Get a -> Deserialize m a liftGet get = Deserialize $ \bs -> return $ convertResult $ Cereal.runGetPartial get bs    where@@ -53,8 +76,9 @@       Cereal.Partial cont -> Partial $ \bs -> return $ convertResult $ cont bs       Cereal.Done a bs -> Done a bs +-- | Change the base monad. Same as `Layers.transMap` of the \"layers\" library. mapBase :: (Monad m, Monad m') => (forall b. m b -> m' b) -> Deserialize m a -> Deserialize m' a-mapBase mToM' (Deserialize runPartial) = Deserialize $ runPartialToRunPartial' runPartial+mapBase mToM' = \(Deserialize runPartial) -> Deserialize $ runPartialToRunPartial' runPartial   where     runPartialToRunPartial' runPartial =        mToM' . runPartial >=> \case

@@ -6,9 +6,7 @@     PVector,     SVector,     UVector,-    (?:),     traceM,-    applyAll,     packText,     unpackText,   )@@ -113,15 +111,8 @@ type UVector = Data.Vector.Unboxed.Vector  -(?:) :: Maybe a -> a -> a-maybeA ?: b = fromMaybe b maybeA-{-# INLINE (?:) #-}- traceM :: (Monad m) => String -> m () traceM s = trace s $ return ()--applyAll :: Monad m => [a -> m b] -> a -> m [b]-applyAll ops a = sequence $ map ($ a) ops  packText = Data.Text.pack unpackText = Data.Text.unpack

@@ -14,13 +14,30 @@  import CerealPlus.Prelude import qualified Data.Serialize.Put as Cereal+import qualified Control.Monad.Layer as Layers   -- | A serialization monad transformer. newtype Serialize m a = Serialize (WriterT (PutM' ()) m a)   deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadPlus, Alternative) +instance (Monad m) => Layers.MonadTransFunctor (Serialize m) where+  transMap = mapBase +instance (Monad m) => Layers.MonadTrans (Serialize m) where+  type Outer (Serialize m) = Serialize+  transInvmap = const . Layers.transMap++instance (Monad m) => Layers.MonadLayerFunctor (Serialize m) where+  layerMap = Layers.transMap++instance (Monad m) => Layers.MonadLayer (Serialize m) where+  type Inner (Serialize m) = m+  layerInvmap = const . Layers.layerMap+  layer = lift+++ newtype PutM' a = PutM' (Cereal.PutM a)   deriving (Functor, Applicative, Monad) @@ -30,29 +47,34 @@   mappend a b = a >> b  +-- | Run and get the monad result paired with a bytestring of serialized data. run :: Monad m => Serialize m a -> m (a, ByteString) run (Serialize w) = do   (a, PutM' putM) <- runWriterT w   return (a, Cereal.runPut putM) +-- | Run and get the monad result paired with a lazy bytestring of serialized data. runLazy :: Monad m => Serialize m a -> m (a, LazyByteString) runLazy (Serialize w) = do   (a, PutM' putM) <- runWriterT w   return (a, Cereal.runPutLazy putM) +-- | Run and get a bytestring of serialized data. exec :: Monad m => Serialize m a -> m ByteString exec (Serialize w) = do   PutM' putM <- execWriterT w   return $ Cereal.runPut putM +-- | Run and get a lazy bytestring of serialized data. execLazy :: Monad m => Serialize m a -> m LazyByteString execLazy (Serialize w) = do   PutM' putM <- execWriterT w   return $ Cereal.runPutLazy putM -+-- | Run a `Cereal.Put` action of the \"cereal\" library. liftPut :: Monad m => Cereal.Put -> Serialize m () liftPut put = Serialize $ tell $ PutM' put +-- | Change the base monad. Same as `Layers.transMap` of the \"layers\" library. mapBase :: (forall b. m b -> m' b) -> Serialize m a -> Serialize m' a mapBase f (Serialize writer) = Serialize $ mapWriterT f writer