bytes 0.1 → 0.2

raw patch · 4 files changed

+225/−1 lines, 4 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• bytes.cabal +3/−1
• src/Data/Bytes/Put.hs +7/−0
• src/Data/Bytes/Serial.hs +211/−0

@@ -1,3 +1,7 @@+0.2+---+* Added `Serial` and `Serial1`.+ 0.1 --- * Repository initialized

@@ -1,6 +1,6 @@ name:          bytes category:      Data, Serialization-version:       0.1+version:       0.2 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -45,12 +45,14 @@     binary                    >= 0.5      && < 0.8,     bytestring                >= 0.9      && < 0.11,     cereal                    >= 0.3.5    && < 0.4,+    ghc-prim,     mtl                       >= 2.0      && < 2.2,     transformers              >= 0.2      && < 0.4,     transformers-compat       >= 0.1      && < 1    exposed-modules:     Data.Bytes.Get+    Data.Bytes.Serial     Data.Bytes.Put    if flag(lib-Werror)

@@ -2,6 +2,9 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------- -- | -- Copyright :  (c) Edward Kmett 2013@@ -33,6 +36,10 @@ import Data.ByteString.Lazy as Lazy import qualified Data.Serialize.Put as S import Data.Word++------------------------------------------------------------------------------+-- MonadPut+------------------------------------------------------------------------------  class Monad m => MonadPut m where   -- | Efficiently write a byte into the output buffer

@@ -0,0 +1,211 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+-- This module generalizes the @binary@ 'B.PutM' and @cereal@ 'S.PutM'+-- monads in an ad hoc fashion to permit code to be written that is+-- compatible across them.+--+-- Moreover, this class permits code to be written to be portable over+-- various monad transformers applied to these as base monads.+--------------------------------------------------------------------+module Data.Bytes.Serial+  ( Serial(..)+  , GSerial(..)+  , Serial1(..), serialize1, deserialize1+  , GSerial1(..)+  ) where++import Control.Monad+import Data.Bytes.Get+import Data.Bytes.Put+import Data.Int+import Data.Word+import GHC.Generics++------------------------------------------------------------------------------+-- Serialization+------------------------------------------------------------------------------++class Serial a where+  serialize :: MonadPut m => a -> m ()+#ifndef HLINT+  default serialize :: (MonadPut m, GSerial (Rep a), Generic a) => a -> m ()+  serialize = gserialize . from+#endif++  deserialize :: MonadGet m => m a+  default deserialize :: (MonadGet m, Generic a, GSerial (Rep a)) => m a+  deserialize = liftM to gdeserialize++instance Serial a => Serial [a]+instance Serial a => Serial (Maybe a)+instance (Serial a, Serial b) => Serial (Either a b)++instance Serial Bool++instance Serial Char where+  serialize = putWord32host . fromIntegral . fromEnum+  deserialize = liftM (toEnum . fromIntegral) getWord32host++instance Serial Word where+  serialize = putWordhost+  deserialize = getWordhost++instance Serial Word64 where+  serialize = putWord64host+  deserialize = getWord64host++instance Serial Word32 where+  serialize = putWord32host+  deserialize = getWord32host++instance Serial Word16 where+  serialize = putWord16host+  deserialize = getWord16host++instance Serial Word8 where+  serialize = putWord8+  deserialize = getWord8++instance Serial Int where+  serialize = putWordhost . fromIntegral+  deserialize = liftM fromIntegral getWordhost++instance Serial Int64 where+  serialize = putWord64host . fromIntegral+  deserialize = liftM fromIntegral getWord64host++instance Serial Int32 where+  serialize = putWord32host . fromIntegral+  deserialize = liftM fromIntegral getWord32host++instance Serial Int16 where+  serialize = putWord16host . fromIntegral+  deserialize = liftM fromIntegral getWord16host++instance Serial Int8 where+  serialize = putWord8 . fromIntegral+  deserialize = liftM fromIntegral getWord8++------------------------------------------------------------------------------+-- Generic Serialization+------------------------------------------------------------------------------++-- | Used internally to provide generic serialization+class GSerial f where+  gserialize :: MonadPut m => f a -> m ()+  gdeserialize :: MonadGet m => m (f a)++instance GSerial U1 where+  gserialize U1 = return ()+  gdeserialize = return U1++instance GSerial V1 where+  gserialize _ = fail "I looked into the void."+  gdeserialize = fail "I looked into the void."++instance (GSerial f, GSerial g) => GSerial (f :*: g) where+  gserialize (f :*: g) = do+    gserialize f+    gserialize g+  gdeserialize = liftM2 (:*:) gdeserialize gdeserialize++instance (GSerial f, GSerial g) => GSerial (f :+: g) where+  gserialize (L1 x) = putWord8 0 >> gserialize x+  gserialize (R1 y) = putWord8 1 >> gserialize y+  gdeserialize = getWord8 >>= \a -> case a of+    0 -> liftM L1 gdeserialize+    1 -> liftM R1 gdeserialize+    _ -> fail "Missing case"++instance GSerial f => GSerial (M1 i c f) where+  gserialize (M1 x) = gserialize x+  gdeserialize = liftM M1 gdeserialize++instance Serial a => GSerial (K1 i a) where+  gserialize (K1 x) = serialize x+  gdeserialize = liftM K1 deserialize++------------------------------------------------------------------------------+-- Higher-Rank Serialization+------------------------------------------------------------------------------++class Serial1 f where+  serializeWith :: MonadPut m => (a -> m ()) -> f a -> m ()+#ifndef HLINT+  default serializeWith :: (MonadPut m, GSerial1 (Rep1 f), Generic1 f) => (a -> m ()) -> f a -> m ()+  serializeWith f = gserializeWith f . from1+#endif++  deserializeWith :: MonadGet m => m a -> m (f a)+#ifndef HLINT+  default deserializeWith :: (MonadGet m, GSerial1 (Rep1 f), Generic1 f) => m a -> m (f a)+  deserializeWith f = liftM to1 (gdeserializeWith f)+#endif++serialize1 :: (MonadPut m, Serial1 f, Serial a) => f a -> m ()+serialize1 = serializeWith serialize+{-# INLINE serialize1 #-}++deserialize1 :: (MonadGet m, Serial1 f, Serial a) => m (f a)+deserialize1 = deserializeWith deserialize+{-# INLINE deserialize1 #-}++------------------------------------------------------------------------------+-- Higher-Rank Generic Serialization+------------------------------------------------------------------------------++-- | Used internally to provide generic serialization+class GSerial1 f where+  gserializeWith :: MonadPut m => (a -> m ()) -> f a -> m ()+  gdeserializeWith :: MonadGet m => m a -> m (f a)++instance GSerial1 Par1 where+  gserializeWith f (Par1 a) = f a+  gdeserializeWith m = liftM Par1 m++instance GSerial1 f => GSerial1 (Rec1 f) where+  gserializeWith f (Rec1 fa) = gserializeWith f fa+  gdeserializeWith m = liftM Rec1 (gdeserializeWith m)++-- instance (Serial1 f, GSerial1 g) => GSerial1 (f :.: g) where++instance GSerial1 U1 where+  gserializeWith _ U1 = return ()+  gdeserializeWith _  = return U1++instance GSerial1 V1 where+  gserializeWith _   = fail "I looked into the void."+  gdeserializeWith _ = fail "I looked into the void."++instance (GSerial1 f, GSerial1 g) => GSerial1 (f :*: g) where+  gserializeWith f (a :*: b) = gserializeWith f a >> gserializeWith f b+  gdeserializeWith m = liftM2 (:*:) (gdeserializeWith m) (gdeserializeWith m)++instance (GSerial1 f, GSerial1 g) => GSerial1 (f :+: g) where+  gserializeWith f (L1 x) = putWord8 0 >> gserializeWith f x+  gserializeWith f (R1 y) = putWord8 1 >> gserializeWith f y+  gdeserializeWith m = getWord8 >>= \a -> case a of+    0 -> liftM L1 (gdeserializeWith m)+    1 -> liftM R1 (gdeserializeWith m)+    _ -> fail "Missing case"++instance GSerial1 f => GSerial1 (M1 i c f) where+  gserializeWith f (M1 x) = gserializeWith f x+  gdeserializeWith = liftM M1 . gdeserializeWith++instance Serial a => GSerial1 (K1 i a) where+  gserializeWith _ (K1 x) = serialize x+  gdeserializeWith _ = liftM K1 deserialize