cereal-plus (empty) → 0.1.0

raw patch · 7 files changed

+806/−0 lines, 7 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, cereal, containers, errors, hashable, hashtables, mtl, stm, text, time, unordered-containers, vector

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• cereal-plus.cabal +100/−0
• src/CerealPlus/Deserialize.hs +64/−0
• src/CerealPlus/Prelude.hs +127/−0
• src/CerealPlus/Serializable.hs +434/−0
• src/CerealPlus/Serialize.hs +57/−0

@@ -0,0 +1,22 @@+Copyright (c) 2013, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,100 @@+name:+  cereal-plus+version:+  0.1.0+synopsis:+  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.++  For a streaming frontend over this library see "pipes-cereal-plus":+  <http://hackage.haskell.org/package/pipes-cereal-plus>+license:+  MIT+license-file:+  LICENSE+homepage:+  https://github.com/nikita-volkov/cereal-plus +bug-reports:+  https://github.com/nikita-volkov/cereal-plus/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2013, Nikita Volkov+category:+  Serialization+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/cereal-plus.git+++library+  hs-source-dirs:+    src+  exposed-modules:+    CerealPlus.Serializable+    CerealPlus.Deserialize+    CerealPlus.Serialize+  other-modules:+    CerealPlus.Prelude+  build-depends:+    cereal == 0.4.*,+    errors,+    time,+    hashable,+    hashtables,+    unordered-containers,+    vector,+    array,+    containers,+    text,+    bytestring,+    stm,+    mtl,+    base >= 4.5 && < 5+  default-extensions:+    Arrows+    DeriveGeneric+    ImpredicativeTypes+    BangPatterns+    PatternGuards+    GADTs+    StandaloneDeriving+    MultiParamTypeClasses+    ScopedTypeVariables+    FlexibleInstances+    TypeFamilies+    TypeOperators+    FlexibleContexts+    NoImplicitPrelude+    EmptyDataDecls+    DataKinds+    NoMonomorphismRestriction+    RankNTypes+    ConstraintKinds+    DefaultSignatures+    TupleSections+    OverloadedStrings+    TemplateHaskell+    QuasiQuotes+    DeriveDataTypeable+    GeneralizedNewtypeDeriving+    RecordWildCards+    MultiWayIf+    LiberalTypeSynonyms+    LambdaCase+  default-language:+    Haskell2010+

@@ -0,0 +1,64 @@+-- |+-- A monad-transformer over "Data.Serialize.Get".+module CerealPlus.Deserialize+  (+    Deserialize,+    runPartial,+    Result(..),+    liftGet,+    mapBase,+  )+  where++import CerealPlus.Prelude+import qualified Data.Serialize.Get as Cereal+++-- | A deserialization monad transformer. +newtype Deserialize m a = Deserialize { runPartial :: ByteString -> m (Result m a) }++instance (Monad m) => Monad (Deserialize m) where+  Deserialize runA >>= aToDeserializeTB = Deserialize $ \bs -> runA bs >>= aToMB where+    aToMB a = case a of+      Fail msg bs -> return $ Fail msg bs+      Partial cont -> return $ Partial $ \bs -> cont bs >>= aToMB+      Done a bs -> case aToDeserializeTB a of Deserialize runB -> runB bs+  return a = Deserialize $ \bs -> return $ Done a bs++instance MonadTrans Deserialize where+  lift m = Deserialize $ \bs -> m >>= \a -> return $ Done a bs++instance (MonadIO m) => MonadIO (Deserialize m) where+  liftIO = lift . liftIO++instance (Monad m) => Applicative (Deserialize m) where+  pure = return+  (<*>) = ap++instance (Monad m) => Functor (Deserialize m) where+  fmap = liftM+++data Result m a = +  Fail Text ByteString |+  Partial (ByteString -> m (Result m a)) |+  Done a ByteString+++liftGet :: Monad m => Cereal.Get a -> Deserialize m a+liftGet get = Deserialize $ \bs -> return $ convertResult $ Cereal.runGetPartial get bs +  where+    convertResult r = case r of+      Cereal.Fail m bs -> Fail (packText m) bs+      Cereal.Partial cont -> Partial $ \bs -> return $ convertResult $ cont bs+      Cereal.Done a bs -> Done a bs++mapBase :: (Monad m, Monad m') => (forall b. m b -> m' b) -> Deserialize m a -> Deserialize m' a+mapBase mToM' (Deserialize runPartial) = Deserialize $ runPartialToRunPartial' runPartial+  where+    runPartialToRunPartial' runPartial = +      mToM' . runPartial >=> \case+        Fail m bs -> return $ Fail m bs+        Partial runPartial' -> return $ Partial $ runPartialToRunPartial' runPartial'+        Done a bs -> return $ Done a bs+

@@ -0,0 +1,127 @@+module CerealPlus.Prelude +  ( +    module Exports,+    LazyByteString,+    LazyText,+    PVector,+    SVector,+    UVector,+    (?:),+    traceM,+    applyAll,+    packText,+    unpackText,+  )+  where++-- base+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (left, right)+import Control.Category as Exports+import Data.Monoid as Exports+import Data.Foldable as Exports+import Data.Traversable as Exports hiding (for)+import Data.Maybe as Exports+import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Tuple as Exports+import Data.Ord as Exports (Down(..))+import Data.String as Exports+import Data.Int as Exports+import Data.Word as Exports+import Data.Ratio as Exports+import Data.Fixed as Exports+import Data.Ix as Exports+import Data.Data as Exports+import Text.Read as Exports (readMaybe, readEither)+import Control.Exception as Exports hiding (tryJust)+import Control.Concurrent as Exports hiding (yield)+import System.Timeout as Exports+import System.Exit as Exports+import System.IO.Unsafe as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import Unsafe.Coerce as Exports+import GHC.Exts as Exports (groupWith, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Debug.Trace as Exports+import Data.IORef as Exports+import Data.STRef as Exports+import Control.Monad.ST as Exports++-- mtl+import Control.Monad.Identity as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Reader as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Writer as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Trans as Exports++-- stm+import Control.Concurrent.STM as Exports++-- bytestring+import Data.ByteString as Exports (ByteString)++-- text+import Data.Text as Exports (Text)++-- containers+import Data.Map as Exports (Map)+import Data.IntMap as Exports (IntMap)+import Data.Set as Exports (Set)+import Data.IntSet as Exports (IntSet)+import Data.Sequence as Exports (Seq)+import Data.Tree as Exports (Tree)++-- unordered-containers+import Data.HashMap.Strict as Exports (HashMap)+import Data.HashSet as Exports (HashSet)++-- array+import Data.Array as Exports (Array)+import Data.Array.Unboxed as Exports (UArray)+import Data.Array.IArray as Exports (IArray)++-- vector+import Data.Vector as Exports (Vector)++-- hashable+import Data.Hashable as Exports (Hashable(..), hash)++-- time+import Data.Time as Exports (Day, DiffTime, NominalDiffTime, UniversalTime, UTCTime, LocalTime, TimeOfDay, TimeZone, ZonedTime)+import Data.Time.Clock.TAI as Exports (AbsoluteTime)++-- errors+import Control.Error as Exports++import qualified Data.ByteString.Lazy+import qualified Data.Text.Lazy+import qualified Data.Vector.Primitive+import qualified Data.Vector.Storable+import qualified Data.Vector.Unboxed+import qualified Data.HashMap.Lazy+import qualified Data.Text+++type LazyByteString = Data.ByteString.Lazy.ByteString+type LazyText = Data.Text.Lazy.Text+type PVector = Data.Vector.Primitive.Vector+type SVector = Data.Vector.Storable.Vector+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+

@@ -0,0 +1,434 @@+module CerealPlus.Serializable (Serializable(..)) where++import CerealPlus.Prelude+import qualified CerealPlus.Serialize as Serialize; import CerealPlus.Serialize (Serialize)+import qualified CerealPlus.Deserialize as Deserialize; import CerealPlus.Deserialize (Deserialize)+import qualified Data.Serialize as Cereal+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy.Encoding as LazyText+import qualified Data.Time as Time+import qualified Data.Time.Clock.TAI as Time+import qualified Data.Tree+import qualified Data.Vector.Generic+import qualified Data.Vector.Primitive+import qualified Data.Vector.Storable+import qualified Data.Vector.Unboxed+import qualified Data.Array.IArray+import qualified Data.Map+import qualified Data.IntMap+import qualified Data.Set+import qualified Data.IntSet+import qualified Data.Sequence+import qualified Data.HashMap.Strict+import qualified Data.HashMap.Lazy+import qualified Data.HashSet+import qualified Data.HashTable.Class as Hashtables_Class+import qualified Data.HashTable.IO as Hashtables_IO+import qualified Data.HashTable.ST.Basic as Hashtables_Basic+import qualified Data.HashTable.ST.Cuckoo as Hashtables_Cuckoo+import qualified Data.HashTable.ST.Linear as Hashtables_Linear+import qualified GHC.Generics as Generics; import GHC.Generics ((:+:)(..), (:*:)(..))+++-- |+-- Support for serialization of a data type in a monadic context +-- (e.g., 'IO', 'ST', 'Control.Concurrent.STM.STM', 'Identity'),+-- meaning that this can be used to provide serialization support for mutable data.+-- +-- To use it in a pure context, refer to 'Identity' monad.+class Serializable a m where+  serialize :: (Monad m, Applicative m) => a -> Serialize m ()+  deserialize :: (Monad m, Applicative m) => Deserialize m a++  default serialize :: +    (Applicative m, Monad m, Generic a, SerializableRep (Generics.Rep a) m) => +    a -> Serialize m ()+  serialize = serializeRep . Generics.from++  default deserialize ::+    (Applicative m, Monad m, Generic a, SerializableRep (Generics.Rep a) m) => +    Deserialize m a+  deserialize = Generics.to <$> deserializeRep+++-- Generics:++class SerializableRep r m where+  serializeRep :: (Applicative m, Monad m) => r a -> Serialize m ()+  deserializeRep :: (Applicative m, Monad m) => Deserialize m (r a)++instance SerializableRep Generics.U1 m where+  serializeRep _ = pure ()+  deserializeRep = pure Generics.U1++instance (SerializableRep a m) => SerializableRep (Generics.M1 i c a) m where+  serializeRep = serializeRep . Generics.unM1+  deserializeRep = Generics.M1 <$> deserializeRep++instance (Serializable a m) => SerializableRep (Generics.K1 i a) m where+  serializeRep = serialize . Generics.unK1+  deserializeRep = Generics.K1 <$> deserialize++instance (SerializableRep a m, SerializableRep b m) => SerializableRep (a :*: b) m where+  serializeRep (a :*: b) = serializeRep a *> serializeRep b+  deserializeRep = (:*:) <$> deserializeRep <*> deserializeRep++instance (SerializableRep a m, SerializableRep b m) => SerializableRep (a :+: b) m where+  serializeRep = \case+    Generics.L1 a -> serialize False *> serializeRep a+    Generics.R1 a -> serialize True *> serializeRep a+  deserializeRep = deserialize >>= \case+    False -> Generics.L1 <$> deserializeRep+    True -> Generics.R1 <$> deserializeRep+++-- Manual instances:++instance (HasResolution a, Fractional (Fixed a)) => Serializable (Fixed a) m where+  serialize = serialize . toRational+  deserialize = fromRational <$> deserialize+++-- 'text' instances:++instance Serializable Text m where+  serialize = serialize . Text.encodeUtf8+  deserialize = Text.decodeUtf8 <$> deserialize++instance Serializable LazyText m where+  serialize = serialize . LazyText.encodeUtf8+  deserialize = LazyText.decodeUtf8 <$> deserialize+++-- 'time' instances:++instance Serializable Day m where+  serialize = serialize . Time.toModifiedJulianDay+  deserialize = Time.ModifiedJulianDay <$> deserialize++instance Serializable DiffTime m where+  serialize = serialize . toRational+  deserialize = fromRational <$> deserialize++instance Serializable UniversalTime m where+  serialize = serialize . Time.getModJulianDate+  deserialize = Time.ModJulianDate <$> deserialize++instance Serializable UTCTime m where+  serialize a = serialize (Time.utctDay a) *> serialize (Time.utctDayTime a)+  deserialize = Time.UTCTime <$> deserialize <*> deserialize++instance Serializable NominalDiffTime m where+  serialize = serialize . toRational+  deserialize = fromRational <$> deserialize++instance Serializable TimeOfDay m where+  serialize a = serialize (Time.todHour a) *> serialize (Time.todMin a) *> serialize (Time.todSec a)+  deserialize = Time.TimeOfDay <$> deserialize <*> deserialize <*> deserialize++instance Serializable TimeZone m where+  serialize a = +    serialize (Time.timeZoneMinutes a) *>+    serialize (Time.timeZoneSummerOnly a) *>+    serialize (Time.timeZoneName a)+  deserialize = Time.TimeZone <$> deserialize <*> deserialize <*> deserialize++instance Serializable LocalTime m where+  serialize a = serialize (Time.localDay a) *> serialize (Time.localTimeOfDay a)+  deserialize = Time.LocalTime <$> deserialize <*> deserialize++instance Serializable ZonedTime m where+  serialize a = serialize (Time.zonedTimeToLocalTime a) *> serialize (Time.zonedTimeZone a)+  deserialize = Time.ZonedTime <$> deserialize <*> deserialize++instance Serializable AbsoluteTime m where+  serialize a = serialize $ Time.diffAbsoluteTime a Time.taiEpoch+  deserialize = toAbsoluteTime <$> deserialize+    where+      toAbsoluteTime dt = Time.addAbsoluteTime dt Time.taiEpoch+++-- 'cereal' primitive instances wrappers:++instance Serializable Bool m where serialize = put; deserialize = get+instance Serializable Char m where serialize = put; deserialize = get+instance Serializable Double m where serialize = put; deserialize = get+instance Serializable Float m where serialize = put; deserialize = get+instance Serializable Int m where serialize = put; deserialize = get+instance Serializable Int8 m where serialize = put; deserialize = get+instance Serializable Int16 m where serialize = put; deserialize = get+instance Serializable Int32 m where serialize = put; deserialize = get+instance Serializable Int64 m where serialize = put; deserialize = get+instance Serializable Integer m where serialize = put; deserialize = get+instance Serializable Ordering m where serialize = put; deserialize = get+instance Serializable Word m where serialize = put; deserialize = get+instance Serializable Word8 m where serialize = put; deserialize = get+instance Serializable Word16 m where serialize = put; deserialize = get+instance Serializable Word32 m where serialize = put; deserialize = get+instance Serializable Word64 m where serialize = put; deserialize = get+instance Serializable () m where serialize = put; deserialize = get+instance Serializable ByteString m where serialize = put; deserialize = get+instance Serializable LazyByteString m where serialize = put; deserialize = get+instance Serializable IntSet m where serialize = put; deserialize = get++put :: (Monad m, Applicative m, Cereal.Serialize a) => a -> Serialize m ()+put = Serialize.liftPut . Cereal.put++get :: (Monad m, Applicative m, Cereal.Serialize a) => Deserialize m a+get = Deserialize.liftGet Cereal.get+++-- Monoid wrappers instances:++instance (Serializable a m) => Serializable (Dual a) m where+  serialize = serialize . \case Dual a -> a+  deserialize = Dual <$> deserialize+  +instance Serializable All m where+  serialize = serialize . \case All a -> a+  deserialize = All <$> deserialize++instance Serializable Any m where+  serialize = serialize . \case Any a -> a+  deserialize = Any <$> deserialize++instance (Serializable a m) => Serializable (Sum a) m where+  serialize = serialize . \case Sum a -> a+  deserialize = Sum <$> deserialize++instance (Serializable a m) => Serializable (Product a) m where+  serialize = serialize . \case Product a -> a+  deserialize = Product <$> deserialize++instance (Serializable a m) => Serializable (First a) m where+  serialize = serialize . \case First a -> a+  deserialize = First <$> deserialize++instance (Serializable a m) => Serializable (Last a) m where+  serialize = serialize . \case Last a -> a+  deserialize = Last <$> deserialize+++-- Composite instances:++instance (Serializable a m, Integral a) => Serializable (Ratio a) m where+  serialize a = serialize (numerator a) *> serialize (denominator a)+  deserialize = (%) <$> deserialize <*> deserialize++instance (Serializable a m) => Serializable (Tree a) m where+  serialize (Data.Tree.Node root sub) = serialize root *> serialize sub+  deserialize = Data.Tree.Node <$> deserialize <*> deserialize++instance (Serializable a m, Serializable b m) => Serializable (Either a b) m where+  serialize = \case+    Right a -> serialize True *> serialize a+    Left a -> serialize False *> serialize a+  deserialize = do+    deserialize >>= \case+      True -> Right <$> deserialize+      False -> Left <$> deserialize++instance (Serializable a m) => Serializable (Maybe a) m where+  serialize = \case +    Just a -> serialize True >> serialize a+    Nothing -> serialize False+  deserialize = do+    z <- deserialize+    if z+      then deserialize >>= return . Just+      else return Nothing++instance (Serializable a m) => Serializable [a] m where+  serialize l = do+    serialize (length l)+    mapM_ serialize l+  deserialize = do+    n <- deserialize+    replicateM n deserialize++instance (Serializable a m) => Serializable (Seq a) m where+  serialize = serialize . toList+  deserialize = Data.Sequence.fromList <$> deserialize+++-- Tuple instances:++instance (Serializable a m) => Serializable (Identity a) m where+  serialize = serialize . \case Identity a -> a+  deserialize = Identity <$> deserialize++instance (Serializable a m, Serializable b m) => Serializable (a, b) m where+  serialize (a, b) = serialize a *> serialize b+  deserialize = (,) <$> deserialize <*> deserialize+  +instance (Serializable a m, Serializable b m, Serializable c m) => Serializable (a, b, c) m where+  serialize (a, b, c) = serialize a *> serialize b *> serialize c+  deserialize = (,,) <$> deserialize <*> deserialize <*> deserialize+  +instance (Serializable a m, Serializable b m, Serializable c m, Serializable d m) => Serializable (a, b, c, d) m where+  serialize (a, b, c, d) = serialize a *> serialize b *> serialize c *> serialize d+  deserialize = (,,,) <$> deserialize <*> deserialize <*> deserialize <*> deserialize++instance (Serializable a m, Serializable b m, Serializable c m, Serializable d m, Serializable e m) => Serializable (a, b, c, d, e) m where+  serialize (a, b, c, d, e) = serialize a *> serialize b *> serialize c *> serialize d *> serialize e+  deserialize = (,,,,) <$> deserialize <*> deserialize <*> deserialize <*> deserialize <*> deserialize+++-- 'containers' instances:++instance (Serializable a m, Ord a) => Serializable (Set a) m where+  serialize = serialize . Data.Set.toAscList+  deserialize = Data.Set.fromDistinctAscList <$> deserialize++instance (Serializable a m) => Serializable (IntMap a) m where+  serialize = serialize . Data.IntMap.toAscList+  deserialize = Data.IntMap.fromDistinctAscList <$> deserialize++instance (Serializable a m, Serializable b m, Ord a) => Serializable (Map a b) m where+  serialize = serialize . Data.Map.toAscList+  deserialize = Data.Map.fromDistinctAscList <$> deserialize+++-- 'unordered-containers' instances:++instance (Serializable a m, Serializable b m, Hashable a, Eq a) => Serializable (HashMap a b) m where+  serialize = serialize . Data.HashMap.Lazy.toList+  deserialize = Data.HashMap.Lazy.fromList <$> deserialize++instance (Serializable a m, Hashable a, Eq a) => Serializable (HashSet a) m where+  serialize = serialize . Data.HashSet.toList+  deserialize = Data.HashSet.fromList <$> deserialize+++-- 'array' instances:++instance (Serializable e m, Serializable i m, Ix i) => Serializable (Array i e) m where+  serialize = serializeArray+  deserialize = deserializeArray++instance (Serializable e m, Serializable i m, IArray UArray e, Ix i) => Serializable (UArray i e) m where+  serialize = serializeArray+  deserialize = deserializeArray++serializeArray :: (Monad m, Applicative m, Ix i, Serializable e m, Serializable i m, IArray a e) => a i e -> Serialize m ()+serializeArray a = do +  serialize $ Data.Array.IArray.bounds a+  serialize $ Data.Array.IArray.elems a++deserializeArray :: (Monad m, Applicative m, Ix i, Serializable e m, Serializable i m, IArray a e) => Deserialize m (a i e)+deserializeArray = Data.Array.IArray.listArray <$> deserialize <*> deserialize+++-- 'vector' instances:++instance (Serializable a m) => Serializable (Vector a) m where+  serialize = serializeVector+  deserialize = deserializeVector++instance (Serializable a m, Data.Vector.Primitive.Prim a) => Serializable (PVector a) m where+  serialize = serializeVector+  deserialize = deserializeVector++instance (Serializable a m, Data.Vector.Storable.Storable a) => Serializable (SVector a) m where+  serialize = serializeVector+  deserialize = deserializeVector++instance (Serializable a m, Data.Vector.Unboxed.Unbox a) => Serializable (UVector a) m where+  serialize = serializeVector+  deserialize = deserializeVector++serializeVector :: (Monad m, Applicative m, Data.Vector.Generic.Vector v a, Serializable a m) => v a -> Serialize m ()+serializeVector a = do+  serialize (Data.Vector.Generic.length a)+  Data.Vector.Generic.mapM_ serialize a++deserializeVector :: (Monad m, Applicative m, Data.Vector.Generic.Vector v a, Serializable a m) => Deserialize m (v a)+deserializeVector = do+  length <- deserialize+  Data.Vector.Generic.replicateM length deserialize+++-- 'hashtables' instances:++instance ( Serializable a (ST s), Serializable b (ST s), Hashable a, Eq a ) => +         Serializable (Hashtables_Basic.HashTable s a b) (ST s) where+  serialize = serializeHashTableST+  deserialize = deserializeHashTableST++instance ( Serializable a (ST s), Serializable b (ST s), Hashable a, Eq a ) => +         Serializable (Hashtables_Cuckoo.HashTable s a b) (ST s) where+  serialize = serializeHashTableST+  deserialize = deserializeHashTableST++instance ( Serializable a (ST s), Serializable b (ST s), Hashable a, Eq a ) => +         Serializable (Hashtables_Linear.HashTable s a b) (ST s) where+  serialize = serializeHashTableST+  deserialize = deserializeHashTableST++serializeHashTableST :: +  (Hashtables_Class.HashTable t, Serializable a (ST s), Serializable b (ST s)) => +  t s a b -> Serialize (ST s) ()+serializeHashTableST t = do+  join $ lift $ Hashtables_Class.foldM (\a b -> return $ a >> processRow b) (return ()) t+  signalEnd+  where+    processRow (k, v) = do+      signalRow+      serialize k+      serialize v+    signalRow = serialize True+    signalEnd = serialize False++deserializeHashTableST :: +  (Hashtables_Class.HashTable t, Serializable a (ST s), Serializable b (ST s), Hashable a, Eq a) => +  Deserialize (ST s) (t s a b)+deserializeHashTableST = do+  t <- lift $ Hashtables_Class.new+  loop $ do+    (k, v) <- deserializeRow+    lift $ Hashtables_Class.insert t k v+  return t+  where+    loop action = do+      deserialize >>= \case+        False -> return ()+        True -> action >> loop action+    deserializeRow = (,) <$> deserialize <*> deserialize++instance ( Serializable a (ST RealWorld), Serializable b (ST RealWorld), Hashable a, Eq a ) => +         Serializable (Hashtables_Basic.HashTable RealWorld a b) IO where+  serialize = Serialize.mapBase stToIO . serializeHashTableST+  deserialize = Deserialize.mapBase stToIO deserializeHashTableST++instance ( Serializable a (ST RealWorld), Serializable b (ST RealWorld), Hashable a, Eq a ) => +         Serializable (Hashtables_Cuckoo.HashTable RealWorld a b) IO where+  serialize = Serialize.mapBase stToIO . serializeHashTableST+  deserialize = Deserialize.mapBase stToIO deserializeHashTableST++instance ( Serializable a (ST RealWorld), Serializable b (ST RealWorld), Hashable a, Eq a ) => +         Serializable (Hashtables_Linear.HashTable RealWorld a b) IO where+  serialize = Serialize.mapBase stToIO . serializeHashTableST+  deserialize = Deserialize.mapBase stToIO deserializeHashTableST+++-- Instances for mutable types from 'base':++instance (Serializable a IO) => Serializable (IORef a) IO where+  serialize = serialize <=< lift . readIORef+  deserialize = lift . newIORef =<< deserialize++instance (Serializable a IO) => Serializable (MVar a) IO where+  serialize = lift . readMVar >=> serialize+  deserialize = deserialize >>= lift . newMVar+++-- Instances for 'stm':++instance (Serializable a STM) => Serializable (TVar a) STM where+  serialize = serialize <=< lift . readTVar+  deserialize = lift . newTVar =<< deserialize++instance (Serializable a IO) => Serializable (TVar a) IO where+  serialize = lift . atomically . readTVar >=> serialize+  deserialize = deserialize >>= lift . atomically . newTVar+

@@ -0,0 +1,57 @@+-- |+-- A monad-transformer over "Data.Serialize.Put".+module CerealPlus.Serialize+  (+    Serialize,+    run,+    runLazy,+    exec,+    execLazy,+    liftPut,+    mapBase,+  )+  where++import CerealPlus.Prelude+import qualified Data.Serialize.Put as Cereal+++-- | A serialization monad transformer.+newtype Serialize m a = Serialize (WriterT (PutM' ()) m a)+  deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadPlus, Alternative)++newtype PutM' a = PutM' (Cereal.PutM a)+  deriving (Functor, Applicative, Monad)++-- | Required for 'WriterT'+instance Monoid (PutM' ()) where+  mempty = return ()+  mappend a b = a >> b+++run :: Monad m => Serialize m a -> m (a, ByteString)+run (Serialize w) = do+  (a, PutM' putM) <- runWriterT w+  return (a, Cereal.runPut putM)++runLazy :: Monad m => Serialize m a -> m (a, LazyByteString)+runLazy (Serialize w) = do+  (a, PutM' putM) <- runWriterT w+  return (a, Cereal.runPutLazy putM)++exec :: Monad m => Serialize m a -> m ByteString+exec (Serialize w) = do+  PutM' putM <- execWriterT w+  return $ Cereal.runPut putM++execLazy :: Monad m => Serialize m a -> m LazyByteString+execLazy (Serialize w) = do+  PutM' putM <- execWriterT w+  return $ Cereal.runPutLazy putM+++liftPut :: Monad m => Cereal.Put -> Serialize m ()+liftPut put = Serialize $ tell $ PutM' put++mapBase :: (forall b. m b -> m' b) -> Serialize m a -> Serialize m' a+mapBase f (Serialize writer) = Serialize $ mapWriterT f writer