cereal-plus 0.3.3 → 0.4.0
raw patch · 5 files changed
+36/−130 lines, 5 filesdep +mmorphdep −QuickCheck-GenTdep −layersdep ~HTFdep ~basedep ~cereal
Dependencies added: mmorph
Dependencies removed: QuickCheck-GenT, layers
Dependency ranges changed: HTF, base, cereal, errors, mtl
Files
- cereal-plus.cabal +17/−75
- library/CerealPlus/Deserialize.hs +8/−25
- library/CerealPlus/Prelude.hs +3/−4
- library/CerealPlus/Serializable.hs +6/−6
- library/CerealPlus/Serialize.hs +2/−20
cereal-plus.cabal view
@@ -1,7 +1,7 @@ name: cereal-plus version:- 0.3.3+ 0.4.0 synopsis: An extended serialization library on top of "cereal" description:@@ -65,50 +65,19 @@ text, bytestring, -- Control:- layers == 0.1.*,- errors,- mtl,- base >= 4.5 && < 5+ mmorph == 1.0.*,+ errors == 1.4.*,+ mtl >= 2 && < 2.3,+ base >= 4.5 && < 4.8+ ghc-options:+ -funbox-strict-fields default-extensions:- Arrows- BangPatterns- ConstraintKinds- DataKinds- DefaultSignatures- DeriveDataTypeable- DeriveGeneric- EmptyDataDecls- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- GeneralizedNewtypeDeriving- ImpredicativeTypes- LambdaCase- LiberalTypeSynonyms- MultiParamTypeClasses- MultiWayIf- NoImplicitPrelude- NoMonomorphismRestriction- OverloadedStrings- PatternGuards- QuasiQuotes- RankNTypes- RecordWildCards- ScopedTypeVariables- StandaloneDeriving- TemplateHaskell- TupleSections- TypeFamilies- TypeOperators+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 test-suite cereal-plus-htf-test-suite- ghc-options:- -threaded- "-with-rtsopts=-N" type: exitcode-stdio-1.0 hs-source-dirs: @@ -119,12 +88,11 @@ cereal-plus, -- testing: quickcheck-instances,- QuickCheck-GenT == 0.1.*, QuickCheck, HUnit,- HTF == 0.11.*,+ HTF == 0.12.*, -- Serialization:- cereal == 0.4.*,+ cereal, -- Concurrency: stm, -- Data:@@ -138,41 +106,15 @@ text, bytestring, -- Control:- layers == 0.1.*,+ mmorph, errors, mtl,- base >= 4.5 && < 5+ base+ ghc-options:+ -funbox-strict-fields+ -threaded+ "-with-rtsopts=-N" default-extensions:- Arrows- BangPatterns- ConstraintKinds- DataKinds- DefaultSignatures- DeriveDataTypeable- DeriveGeneric- EmptyDataDecls- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- GeneralizedNewtypeDeriving- ImpredicativeTypes- LambdaCase- LiberalTypeSynonyms- MultiParamTypeClasses- MultiWayIf- NoImplicitPrelude- NoMonomorphismRestriction- OverloadedStrings- PatternGuards- QuasiQuotes- RankNTypes- RecordWildCards- ScopedTypeVariables- StandaloneDeriving- TemplateHaskell- TupleSections- TypeFamilies- TypeOperators+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010
library/CerealPlus/Deserialize.hs view
@@ -6,14 +6,12 @@ runPartial, Result(..), liftGet,- mapBase, throwError, ) where import CerealPlus.Prelude import qualified Data.Serialize.Get as Cereal-import qualified Control.Monad.Layer as Layers -- | A deserialization monad transformer. @@ -43,20 +41,8 @@ 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+instance MFunctor Deserialize where+ hoist nat (Deserialize k) = Deserialize (nat . liftM (hoist nat) . k) -- | A partial result of deserialization.@@ -68,6 +54,12 @@ -- | A deserialized data structure and a remaining chunk. Done a ByteString +instance MFunctor Result where+ hoist nat (Fail str bs) = Fail str bs+ hoist nat (Partial k) = Partial (nat . liftM (hoist nat) . k)+ hoist nat (Done a bs) = Done a bs++ -- | 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 @@ -77,15 +69,6 @@ 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- 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 -- | -- Fail with a message.
library/CerealPlus/Prelude.hs view
@@ -6,7 +6,6 @@ PVector, SVector, UVector,- traceM, packText, unpackText, )@@ -55,6 +54,9 @@ import Control.Monad.Writer as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Control.Monad.Trans as Exports +-- mmorph+import Control.Monad.Morph as Exports+ -- stm import Control.Concurrent.STM as Exports @@ -110,9 +112,6 @@ type SVector = Data.Vector.Storable.Vector type UVector = Data.Vector.Unboxed.Vector --traceM :: (Monad m) => String -> m ()-traceM s = trace s $ return () packText = Data.Text.pack unpackText = Data.Text.unpack
library/CerealPlus/Serializable.hs view
@@ -422,18 +422,18 @@ instance ( Serializable (ST RealWorld) a, Serializable (ST RealWorld) b, Hashable a, Eq a ) => Serializable IO (Hashtables_Basic.HashTable RealWorld a b) where- serialize = Serialize.mapBase stToIO . serializeHashTableST- deserialize = Deserialize.mapBase stToIO deserializeHashTableST+ serialize = hoist stToIO . serializeHashTableST+ deserialize = hoist stToIO deserializeHashTableST instance ( Serializable (ST RealWorld) a, Serializable (ST RealWorld) b, Hashable a, Eq a ) => Serializable IO (Hashtables_Cuckoo.HashTable RealWorld a b) where- serialize = Serialize.mapBase stToIO . serializeHashTableST- deserialize = Deserialize.mapBase stToIO deserializeHashTableST+ serialize = hoist stToIO . serializeHashTableST+ deserialize = hoist stToIO deserializeHashTableST instance ( Serializable (ST RealWorld) a, Serializable (ST RealWorld) b, Hashable a, Eq a ) => Serializable IO (Hashtables_Linear.HashTable RealWorld a b) where- serialize = Serialize.mapBase stToIO . serializeHashTableST- deserialize = Deserialize.mapBase stToIO deserializeHashTableST+ serialize = hoist stToIO . serializeHashTableST+ deserialize = hoist stToIO deserializeHashTableST -- Instances for mutable types from 'base':
library/CerealPlus/Serialize.hs view
@@ -8,33 +8,19 @@ exec, execLazy, liftPut,- mapBase, ) where 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+instance MFunctor Serialize where+ hoist f (Serialize writer) = Serialize $ mapWriterT f writer @@ -74,7 +60,3 @@ -- | 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