Hello community,
here is the log from the commit of package ghc-cereal for openSUSE:Factory
checked in at 2016-06-02 09:40:05
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-cereal (Old)
and /work/SRC/openSUSE:Factory/.ghc-cereal.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-cereal"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-cereal/ghc-cereal.changes 2016-01-28
17:24:33.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-cereal.new/ghc-cereal.changes
2016-06-02 09:40:06.000000000 +0200
@@ -1,0 +2,10 @@
+Wed Jun 1 19:07:52 UTC 2016 - mimi...@gmail.com
+
+- update to 0.5.2.0
+* Implement the AMP recommended refactoring for the Functor/Applicative/Monad
+ hierarchy for Get and PutM
+* Unconditionally support GHC generics
+* Split the GSerialize class in two, to deal with a GHC bug
+* No longer use Enum in the Serialize instance for Bool
+
+-------------------------------------------------------------------
Old:
----
cereal-0.5.1.0.tar.gz
New:
----
cereal-0.5.2.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-cereal.spec ++++++
--- /var/tmp/diff_new_pack.oiJ2Vd/_old 2016-06-02 09:40:07.000000000 +0200
+++ /var/tmp/diff_new_pack.oiJ2Vd/_new 2016-06-02 09:40:07.000000000 +0200
@@ -17,22 +17,22 @@
%global pkg_name cereal
-# no useful debuginfo for Haskell packages without C sources
-%global debug_package %{nil}
Name: ghc-cereal
-Version: 0.5.1.0
+Version: 0.5.2.0
Release: 0
Summary: A binary serialization library
License: BSD-3-Clause
Group: System/Libraries
Url: http://hackage.haskell.org/package/%{pkg_name}
-Source0:
http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz
+Source0:
http://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
Source1: %{name}-rpmlintrc
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-array-devel
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-containers-devel
+# fail is needed on ghc 7.x
+BuildRequires: ghc-fail-devel
BuildRequires: ghc-rpm-macros
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: ghc-rpm-macros
++++++ cereal-0.5.1.0.tar.gz -> cereal-0.5.2.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/CHANGELOG.md
new/cereal-0.5.2.0/CHANGELOG.md
--- old/cereal-0.5.1.0/CHANGELOG.md 2015-11-12 18:53:27.000000000 +0100
+++ new/cereal-0.5.2.0/CHANGELOG.md 2016-05-28 01:48:29.000000000 +0200
@@ -1,4 +1,18 @@
+0.5.2.0
+======
+
+* Implement the AMP recommended refactoring for the Functor/Applicative/Monad
+ hierarchy for Get and PutM (thanks to Herbert Valerio Riedel!)
+* Unconditionally support GHC generics (thanks to Eric Mertens!)
+* Split the GSerialize class in two, to deal with a GHC bug (thanks Austin
Seipp!)
+* No longer use Enum in the Serialize instance for Bool (thanks Francesco
Mazzoli!)
+
+0.5.1.0
+=======
+
+* Re-enable GHC.Generics support which was accidentally removed in 0.5.0.0
+
0.5.0.0
=======
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/cereal.cabal
new/cereal-0.5.2.0/cereal.cabal
--- old/cereal-0.5.1.0/cereal.cabal 2015-11-12 18:53:27.000000000 +0100
+++ new/cereal-0.5.2.0/cereal.cabal 2016-05-28 01:48:29.000000000 +0200
@@ -1,5 +1,5 @@
name: cereal
-version: 0.5.1.0
+version: 0.5.2.0
license: BSD3
license-file: LICENSE
author: Lennart Kolmodin <kolmo...@dtek.chalmers.se>,
@@ -13,6 +13,7 @@
cabal-version: >= 1.10
synopsis: A binary serialization library
homepage: https://github.com/GaloisInc/cereal
+tested-with: GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC ==
7.8.4, GHC == 7.10.2
description:
A binary serialization library, similar to binary, that introduces an isolate
@@ -27,10 +28,13 @@
library
default-language: Haskell2010
- build-depends: bytestring >= 0.10.0.0,
+ build-depends: bytestring >= 0.10.2.0,
base >= 4.4 && < 5, containers, array,
ghc-prim >= 0.2
+ if !impl(ghc >= 8.0)
+ build-depends: fail == 4.9.*
+
hs-source-dirs: src
exposed-modules: Data.Serialize,
@@ -40,9 +44,6 @@
ghc-options: -Wall -O2 -funbox-strict-fields
- if impl(ghc >= 7.2.1)
- cpp-options: -DGENERICS
- build-depends: ghc-prim >= 0.2
test-suite test-cereal
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/src/Data/Serialize/Get.hs
new/cereal-0.5.2.0/src/Data/Serialize/Get.hs
--- old/cereal-0.5.1.0/src/Data/Serialize/Get.hs 2015-11-12
18:53:27.000000000 +0100
+++ new/cereal-0.5.2.0/src/Data/Serialize/Get.hs 2016-05-28
01:48:29.000000000 +0200
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
@@ -98,12 +99,12 @@
, getMaybeOf
, getEitherOf
, getNested
-
) where
import qualified Control.Applicative as A
import qualified Control.Monad as M
import Control.Monad (unless)
+import qualified Control.Monad.Fail as Fail
import Data.Array.IArray (IArray,listArray)
import Data.Ix (Ix)
import Data.List (intercalate)
@@ -171,7 +172,7 @@
extendBuffer :: Buffer -> B.ByteString -> Buffer
extendBuffer buf chunk =
do bs <- buf
- return (bs `B.append` chunk)
+ return $! bs `B.append` chunk
{-# INLINE extendBuffer #-}
append :: Buffer -> Buffer -> Buffer
@@ -201,7 +202,7 @@
unGet m s0 b0 m0 kf $ \ s1 b1 m1 a -> ks s1 b1 m1 (p a)
instance A.Applicative Get where
- pure = return
+ pure a = Get $ \ s0 b0 m0 _ ks -> ks s0 b0 m0 a
{-# INLINE pure #-}
f <*> x = Get $ \ s0 b0 m0 kf ks ->
@@ -209,6 +210,10 @@
unGet x s1 b1 m1 kf $ \ s2 b2 m2 y -> ks s2 b2 m2 (g y)
{-# INLINE (<*>) #-}
+ m *> k = Get $ \ s0 b0 m0 kf ks ->
+ unGet m s0 b0 m0 kf $ \ s1 b1 m1 _ -> unGet k s1 b1 m1 kf ks
+ {-# INLINE (*>) #-}
+
instance A.Alternative Get where
empty = failDesc "empty"
{-# INLINE empty #-}
@@ -218,20 +223,22 @@
-- Definition directly from Control.Monad.State.Strict
instance Monad Get where
- return a = Get $ \ s0 b0 m0 _ ks -> ks s0 b0 m0 a
+ return = A.pure
{-# INLINE return #-}
m >>= g = Get $ \ s0 b0 m0 kf ks ->
unGet m s0 b0 m0 kf $ \ s1 b1 m1 a -> unGet (g a) s1 b1 m1 kf ks
{-# INLINE (>>=) #-}
- m >> k = Get $ \ s0 b0 m0 kf ks ->
- unGet m s0 b0 m0 kf $ \ s1 b1 m1 _ -> unGet k s1 b1 m1 kf ks
+ (>>) = (A.*>)
{-# INLINE (>>) #-}
- fail = failDesc
+ fail = Fail.fail
{-# INLINE fail #-}
+instance Fail.MonadFail Get where
+ fail = failDesc
+ {-# INLINE fail #-}
instance M.MonadPlus Get where
mzero = failDesc "mzero"
@@ -363,20 +370,44 @@
-- | If at least @n@ bytes of input are available, return the current
-- input, otherwise fail.
-ensure :: Int -> Get B.ByteString
-ensure n = n `seq` Get $ \ s0 b0 m0 kf ks ->
- if B.length s0 >= n
- then ks s0 b0 m0 s0
- else unGet (demandInput >> ensureRec n) s0 b0 m0 kf ks
{-# INLINE ensure #-}
-
--- | If at least @n@ bytes of input are available, return the current
--- input, otherwise fail.
-ensureRec :: Int -> Get B.ByteString
-ensureRec n = Get $ \s0 b0 m0 kf ks ->
- if B.length s0 >= n
- then ks s0 b0 m0 s0
- else unGet (demandInput >> ensureRec n) s0 b0 m0 kf ks
+ensure :: Int -> Get B.ByteString
+ensure n0 = n0 `seq` Get $ \ s0 b0 m0 kf ks -> let
+ n' = n0 - B.length s0
+ in if n' <= 0
+ then ks s0 b0 m0 s0
+ else getMore n' s0 [] b0 m0 kf ks
+ where
+ -- The "accumulate and concat" pattern here is important not to incur
+ -- in quadratic behavior, see
<https://github.com/GaloisInc/cereal/issues/48>
+
+ finalInput s0 ss = B.concat (reverse (s0 : ss))
+ finalBuffer b0 s0 ss = extendBuffer b0 (B.concat (reverse (init (s0 :
ss))))
+
+ getMore !n s0 ss b0 m0 kf ks = let
+ tooFewBytes = let
+ !s = finalInput s0 ss
+ !b = finalBuffer b0 s0 ss
+ in kf s b m0 ["demandInput"] "too few bytes"
+ in case m0 of
+ Complete -> tooFewBytes
+ Incomplete mb -> Partial $ \s ->
+ if B.null s
+ then tooFewBytes
+ else let
+ !mb' = case mb of
+ Just l -> Just $! l - B.length s
+ Nothing -> Nothing
+ in checkIfEnough n s (s0 : ss) b0 (Incomplete mb')
kf ks
+
+ checkIfEnough !n s0 ss b0 m0 kf ks = let
+ n' = n - B.length s0
+ in if n' <= 0
+ then let
+ !s = finalInput s0 ss
+ !b = finalBuffer b0 s0 ss
+ in ks s b m0 s
+ else getMore n' s0 ss b0 m0 kf ks
-- | Isolate an action to operating within a fixed block of bytes. The action
-- is required to consume all the bytes that it is isolated to.
@@ -392,23 +423,6 @@
put rest
return a
--- | Immediately demand more input via a 'Partial' continuation
--- result.
-demandInput :: Get ()
-demandInput = Get $ \s0 b0 m0 kf ks ->
- case m0 of
- Complete -> kf s0 b0 m0 ["demandInput"] "too few bytes"
- Incomplete mb -> Partial $ \s ->
- if B.null s
- then kf s0 b0 m0 ["demandInput"] "too few bytes"
- else let s1 = s0 `B.append` s
- b1 = extendBuffer b0 s
- mb' = case mb of
- Just l -> Just $! l - B.length s
- Nothing -> Nothing
- in b1 `seq`
- mb' `seq` ks s1 b1 (Incomplete mb') ()
-
failDesc :: String -> Get a
failDesc err = do
let msg = "Failed reading: " ++ err
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/src/Data/Serialize/IEEE754.hs
new/cereal-0.5.2.0/src/Data/Serialize/IEEE754.hs
--- old/cereal-0.5.1.0/src/Data/Serialize/IEEE754.hs 2015-11-12
18:53:27.000000000 +0100
+++ new/cereal-0.5.2.0/src/Data/Serialize/IEEE754.hs 2016-05-28
01:48:29.000000000 +0200
@@ -1,14 +1,11 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
-#ifndef MIN_VERSION_array
-#define MIN_VERSION_array(x,y,z) 1
-#endif
-
-- | IEEE-754 parsing, as described in this stack-overflow article:
--
--
<http://stackoverflow.com/questions/6976684/converting-ieee-754-floating-point-in-haskell-word32-64-to-and-from-haskell-float/7002812#7002812>
@@ -29,23 +26,19 @@
) where
-import Control.Monad.ST ( runST, ST )
-
-import Data.Array.ST ( newArray, readArray, MArray, STUArray )
import Data.Word ( Word32, Word64 )
import Data.Serialize.Get
import Data.Serialize.Put
+import qualified Data.ByteString.Builder as Builder
+import System.IO.Unsafe (unsafeDupablePerformIO)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (peek, poke)
+import Foreign.Ptr (castPtr, Ptr)
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ( (<$>) )
#endif
-#if MIN_VERSION_array(0,4,0)
-import Data.Array.Unsafe (castSTUArray)
-#else
-import Data.Array.ST (castSTUArray)
-#endif
-
-- | Read a Float in little endian IEEE-754 format
getFloat32le :: Get Float
getFloat32le = wordToFloat <$> getWord32le
@@ -64,38 +57,28 @@
-- | Write a Float in little endian IEEE-754 format
putFloat32le :: Float -> Put
-putFloat32le = putWord32le . floatToWord
+putFloat32le = putBuilder . Builder.floatLE
-- | Write a Float in big endian IEEE-754 format
putFloat32be :: Float -> Put
-putFloat32be = putWord32be . floatToWord
+putFloat32be = putBuilder . Builder.floatBE
-- | Write a Double in little endian IEEE-754 format
putFloat64le :: Double -> Put
-putFloat64le = putWord64le . doubleToWord
+putFloat64le = putBuilder . Builder.doubleLE
-- | Write a Double in big endian IEEE-754 format
putFloat64be :: Double -> Put
-putFloat64be = putWord64be . doubleToWord
+putFloat64be = putBuilder . Builder.doubleBE
{-# INLINE wordToFloat #-}
wordToFloat :: Word32 -> Float
-wordToFloat x = runST (cast x)
-
-{-# INLINE floatToWord #-}
-floatToWord :: Float -> Word32
-floatToWord x = runST (cast x)
+wordToFloat w = unsafeDupablePerformIO $ alloca $ \(ptr :: Ptr Word32) -> do
+ poke ptr w
+ peek (castPtr ptr)
{-# INLINE wordToDouble #-}
wordToDouble :: Word64 -> Double
-wordToDouble x = runST (cast x)
-
-{-# INLINE doubleToWord #-}
-doubleToWord :: Double -> Word64
-doubleToWord x = runST (cast x)
-
-{-# INLINE cast #-}
-cast :: (MArray (STUArray s) a (ST s),
- MArray (STUArray s) b (ST s)) =>
- a -> ST s b
-cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0
+wordToDouble w = unsafeDupablePerformIO $ alloca $ \(ptr :: Ptr Word64) -> do
+ poke ptr w
+ peek (castPtr ptr)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/src/Data/Serialize/Put.hs
new/cereal-0.5.2.0/src/Data/Serialize/Put.hs
--- old/cereal-0.5.1.0/src/Data/Serialize/Put.hs 2015-11-12
18:53:27.000000000 +0100
+++ new/cereal-0.5.2.0/src/Data/Serialize/Put.hs 2016-05-28
01:48:29.000000000 +0200
@@ -138,7 +138,7 @@
instance A.Applicative PutM where
- pure = return
+ pure a = Put (PairS a M.mempty)
{-# INLINE pure #-}
m <*> k = Put $
@@ -147,9 +147,15 @@
in PairS (f x) (w `M.mappend` w')
{-# INLINE (<*>) #-}
+ m *> k = Put $
+ let PairS _ w = unPut m
+ PairS b w' = unPut k
+ in PairS b (w `M.mappend` w')
+ {-# INLINE (*>) #-}
+
instance Monad PutM where
- return a = Put (PairS a M.mempty)
+ return = pure
{-# INLINE return #-}
m >>= k = Put $
@@ -158,10 +164,7 @@
in PairS b (w `M.mappend` w')
{-# INLINE (>>=) #-}
- m >> k = Put $
- let PairS _ w = unPut m
- PairS b w' = unPut k
- in PairS b (w `M.mappend` w')
+ (>>) = (*>)
{-# INLINE (>>) #-}
tell :: Putter Builder
@@ -326,7 +329,7 @@
go (T.Node x cs) = execPut (pa x) `M.mappend` encodeListOf go cs
{-# INLINE putTreeOf #-}
-putMapOf :: Ord k => Putter k -> Putter a -> Putter (Map.Map k a)
+putMapOf :: Putter k -> Putter a -> Putter (Map.Map k a)
putMapOf pk pa = putListOf (putTwoOf pk pa) . Map.toAscList
{-# INLINE putMapOf #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/cereal-0.5.1.0/src/Data/Serialize.hs
new/cereal-0.5.2.0/src/Data/Serialize.hs
--- old/cereal-0.5.1.0/src/Data/Serialize.hs 2015-11-12 18:53:27.000000000
+0100
+++ new/cereal-0.5.2.0/src/Data/Serialize.hs 2016-05-28 01:48:29.000000000
+0200
@@ -1,14 +1,11 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
-
-#ifdef GENERICS
{-# LANGUAGE DefaultSignatures
, TypeOperators
, BangPatterns
, KindSignatures
, ScopedTypeVariables #-}
-#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
@@ -41,6 +38,10 @@
, module Data.Serialize.Get
, module Data.Serialize.Put
, module Data.Serialize.IEEE754
+
+ -- * Generic deriving
+ , GSerializePut(..)
+ , GSerializeGet(..)
) where
import Data.Serialize.Put
@@ -67,9 +68,7 @@
import qualified Data.Tree as T
import qualified Data.Sequence as Seq
-#ifdef GENERICS
import GHC.Generics
-#endif
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ((*>),(<*>),(<$>),pure)
@@ -95,13 +94,11 @@
-- | Decode a value in the Get monad
get :: Get t
-#ifdef GENERICS
- default put :: (Generic t, GSerialize (Rep t)) => Putter t
+ default put :: (Generic t, GSerializePut (Rep t)) => Putter t
put = gPut . from
- default get :: (Generic t, GSerialize (Rep t)) => Get t
+ default get :: (Generic t, GSerializeGet (Rep t)) => Get t
get = to <$> gGet
-#endif
------------------------------------------------------------------------
-- Wrappers to run the underlying monad
@@ -143,15 +140,39 @@
put () = return ()
get = return ()
+{-# INLINE boolToWord8 #-}
+boolToWord8 :: Bool -> Word8
+boolToWord8 False = 0
+boolToWord8 True = 1
+
+{-# INLINE boolFromWord8 #-}
+boolFromWord8 :: Word8 -> Get Bool
+boolFromWord8 0 = return False
+boolFromWord8 1 = return True
+boolFromWord8 w = fail ("Invalid Bool encoding " ++ show w)
+
+{-# INLINE orderingToWord8 #-}
+orderingToWord8 :: Ordering -> Word8
+orderingToWord8 LT = 0
+orderingToWord8 EQ = 1
+orderingToWord8 GT = 2
+
+{-# INLINE orderingFromWord8 #-}
+orderingFromWord8 :: Word8 -> Get Ordering
+orderingFromWord8 0 = return LT
+orderingFromWord8 1 = return EQ
+orderingFromWord8 2 = return GT
+orderingFromWord8 w = fail ("Invalid Ordering encoding " ++ show w)
+
-- Bools are encoded as a byte in the range 0 .. 1
instance Serialize Bool where
- put = putWord8 . fromIntegral . fromEnum
- get = liftM (toEnum . fromIntegral) getWord8
+ put = putWord8 . boolToWord8
+ get = boolFromWord8 =<< getWord8
-- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
instance Serialize Ordering where
- put = putWord8 . fromIntegral . fromEnum
- get = liftM (toEnum . fromIntegral) getWord8
+ put = putWord8 . orderingToWord8
+ get = orderingFromWord8 =<< getWord8
------------------------------------------------------------------------
-- Words and Ints
@@ -249,13 +270,13 @@
--
-- Fold and unfold an Integer to and from a list of its bytes
--
-unroll :: (Integral a, Num a, Bits a) => a -> [Word8]
+unroll :: (Integral a, Bits a) => a -> [Word8]
unroll = unfoldr step
where
step 0 = Nothing
step i = Just (fromIntegral i, i `shiftR` 8)
-roll :: (Integral a, Num a, Bits a) => [Word8] -> a
+roll :: (Integral a, Bits a) => [Word8] -> a
roll = foldr unstep 0
where
unstep b a = a `shiftL` 8 .|. fromIntegral b
@@ -523,39 +544,48 @@
put = putIArrayOf put put
get = getIArrayOf get get
-#ifdef GENERICS
------------------------------------------------------------------------
-- Generic Serialze
-class GSerialize f where
+class GSerializePut f where
gPut :: Putter (f a)
+
+class GSerializeGet f where
gGet :: Get (f a)
-instance GSerialize a => GSerialize (M1 i c a) where
+instance GSerializePut a => GSerializePut (M1 i c a) where
gPut = gPut . unM1
- gGet = M1 <$> gGet
{-# INLINE gPut #-}
+
+instance GSerializeGet a => GSerializeGet (M1 i c a) where
+ gGet = M1 <$> gGet
{-# INLINE gGet #-}
-instance Serialize a => GSerialize (K1 i a) where
+instance Serialize a => GSerializePut (K1 i a) where
gPut = put . unK1
- gGet = K1 <$> get
{-# INLINE gPut #-}
+
+instance Serialize a => GSerializeGet (K1 i a) where
+ gGet = K1 <$> get
{-# INLINE gGet #-}
-instance GSerialize U1 where
+instance GSerializePut U1 where
gPut _ = pure ()
- gGet = pure U1
{-# INLINE gPut #-}
+
+instance GSerializeGet U1 where
+ gGet = pure U1
{-# INLINE gGet #-}
-instance (GSerialize a, GSerialize b) => GSerialize (a :*: b) where
+instance (GSerializePut a, GSerializePut b) => GSerializePut (a :*: b) where
gPut (a :*: b) = gPut a *> gPut b
- gGet = (:*:) <$> gGet <*> gGet
{-# INLINE gPut #-}
+
+instance (GSerializeGet a, GSerializeGet b) => GSerializeGet (a :*: b) where
+ gGet = (:*:) <$> gGet <*> gGet
{-# INLINE gGet #-}
--- The following GSerialize instance for sums has support for serializing types
+-- The following GSerialize* instance for sums has support for serializing
types
-- with up to 2^64-1 constructors. It will use the minimal number of bytes
-- needed to encode the constructor. For example when a type has 2^8
-- constructors or less it will use a single byte to encode the constructor. If
@@ -565,20 +595,20 @@
#define PUTSUM(WORD) GUARD(WORD) = putSum (0 :: WORD) (fromIntegral size)
#define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum
(fromIntegral size)
-instance ( PutSum a, PutSum b
- , GetSum a, GetSum b
- , GSerialize a, GSerialize b
- , SumSize a, SumSize b) => GSerialize (a :+: b) where
+instance ( PutSum a, PutSum b
+ , SumSize a, SumSize b) => GSerializePut (a :+: b) where
gPut | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64)
| otherwise = sizeError "encode" size
where
size = unTagged (sumSize :: Tagged (a :+: b) Word64)
+ {-# INLINE gPut #-}
+instance ( GetSum a, GetSum b
+ , SumSize a, SumSize b) => GSerializeGet (a :+: b) where
gGet | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64)
| otherwise = sizeError "decode" size
where
size = unTagged (sumSize :: Tagged (a :+: b) Word64)
- {-# INLINE gPut #-}
{-# INLINE gGet #-}
sizeError :: Show size => String -> size -> error
@@ -589,7 +619,7 @@
class PutSum f where
putSum :: (Num word, Bits word, Serialize word) => word -> word -> Putter
(f a)
-instance (PutSum a, PutSum b, GSerialize a, GSerialize b) => PutSum (a :+: b)
where
+instance (PutSum a, PutSum b) => PutSum (a :+: b) where
putSum !code !size s = case s of
L1 x -> putSum code sizeL x
R1 x -> putSum (code + sizeL) sizeR x
@@ -602,7 +632,7 @@
sizeR = size - sizeL
{-# INLINE putSum #-}
-instance GSerialize a => PutSum (C1 c a) where
+instance GSerializePut a => PutSum (C1 c a) where
putSum !code _ x = put code *> gPut x
{-# INLINE putSum #-}
@@ -617,7 +647,7 @@
class GetSum f where
getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a)
-instance (GetSum a, GetSum b, GSerialize a, GSerialize b) => GetSum (a :+: b)
where
+instance (GetSum a, GetSum b) => GetSum (a :+: b) where
getSum !code !size | code < sizeL = L1 <$> getSum code sizeL
| otherwise = R1 <$> getSum (code - sizeL) sizeR
where
@@ -629,7 +659,7 @@
sizeR = size - sizeL
{-# INLINE getSum #-}
-instance GSerialize a => GetSum (C1 c a) where
+instance GSerializeGet a => GetSum (C1 c a) where
getSum _ _ = gGet
{-# INLINE getSum #-}
@@ -646,4 +676,3 @@
instance SumSize (C1 c a) where
sumSize = Tagged 1
-#endif
