Hello community, here is the log from the commit of package ghc-cereal for openSUSE:Factory checked in at 2018-05-30 12:03:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-cereal (Old) and /work/SRC/openSUSE:Factory/.ghc-cereal.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-cereal" Wed May 30 12:03:56 2018 rev:8 rq:607764 version:0.5.5.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-cereal/ghc-cereal.changes 2017-09-15 21:25:52.936594433 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-cereal.new/ghc-cereal.changes 2018-05-30 12:25:03.666807072 +0200 @@ -1,0 +2,6 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update cereal to version 0.5.5.0. + Upstream does not provide a changelog. + +------------------------------------------------------------------- Old: ---- cereal-0.5.4.0.tar.gz New: ---- cereal-0.5.5.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-cereal.spec ++++++ --- /var/tmp/diff_new_pack.urRFpK/_old 2018-05-30 12:25:04.838769050 +0200 +++ /var/tmp/diff_new_pack.urRFpK/_new 2018-05-30 12:25:04.842768921 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-cereal # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name cereal %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.4.0 +Version: 0.5.5.0 Release: 0 Summary: A binary serialization library License: BSD-3-Clause @@ -71,7 +71,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files %doc CHANGELOG.md ++++++ cereal-0.5.4.0.tar.gz -> cereal-0.5.5.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cereal-0.5.4.0/CHANGELOG.md new/cereal-0.5.5.0/CHANGELOG.md --- old/cereal-0.5.4.0/CHANGELOG.md 2016-11-09 01:40:53.000000000 +0100 +++ new/cereal-0.5.5.0/CHANGELOG.md 2018-01-22 23:50:15.000000000 +0100 @@ -1,4 +1,10 @@ +0.5.4.0 +======= + +* Allow building with older versions of GHC (thanks to Ryan Scott!) +* Additional putters for ints (thanks to Andrew Martin!) + 0.5.2.0 ====== diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cereal-0.5.4.0/cereal.cabal new/cereal-0.5.5.0/cereal.cabal --- old/cereal-0.5.4.0/cereal.cabal 2016-11-09 01:40:53.000000000 +0100 +++ new/cereal-0.5.5.0/cereal.cabal 2018-01-22 23:50:15.000000000 +0100 @@ -1,5 +1,5 @@ name: cereal -version: 0.5.4.0 +version: 0.5.5.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <[email protected]>, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cereal-0.5.4.0/src/Data/Serialize/Get.hs new/cereal-0.5.5.0/src/Data/Serialize/Get.hs --- old/cereal-0.5.4.0/src/Data/Serialize/Get.hs 2016-11-09 01:40:53.000000000 +0100 +++ new/cereal-0.5.5.0/src/Data/Serialize/Get.hs 2018-01-22 23:50:15.000000000 +0100 @@ -46,6 +46,7 @@ , lookAheadM , lookAheadE , uncheckedLookAhead + , bytesRead -- * Utility , getBytes @@ -152,8 +153,8 @@ -- | The Get monad is an Exception and State monad. newtype Get a = Get { unGet :: forall r. Input -> Buffer -> More - -> Failure r -> Success a r - -> Result r } + -> Int -> Failure r + -> Success a r -> Result r } type Input = B.ByteString type Buffer = Maybe B.ByteString @@ -176,7 +177,7 @@ {-# INLINE bufferBytes #-} type Failure r = Input -> Buffer -> More -> [String] -> String -> Result r -type Success a r = Input -> Buffer -> More -> a -> Result r +type Success a r = Input -> Buffer -> More -> Int -> a -> Result r -- | Have we read all available input? data More @@ -190,20 +191,20 @@ Incomplete mb -> fromMaybe 0 mb instance Functor Get where - fmap p m = Get $ \ s0 b0 m0 kf ks -> - unGet m s0 b0 m0 kf $ \ s1 b1 m1 a -> ks s1 b1 m1 (p a) + fmap p m = Get $ \ s0 b0 m0 w0 kf ks -> + unGet m s0 b0 m0 w0 kf $ \ s1 b1 m1 w1 a -> ks s1 b1 m1 w1 (p a) instance A.Applicative Get where - pure a = Get $ \ s0 b0 m0 _ ks -> ks s0 b0 m0 a + pure a = Get $ \ s0 b0 m0 w _ ks -> ks s0 b0 m0 w a {-# INLINE pure #-} - f <*> x = Get $ \ s0 b0 m0 kf ks -> - unGet f s0 b0 m0 kf $ \ s1 b1 m1 g -> - unGet x s1 b1 m1 kf $ \ s2 b2 m2 y -> ks s2 b2 m2 (g y) + f <*> x = Get $ \ s0 b0 m0 w0 kf ks -> + unGet f s0 b0 m0 w0 kf $ \ s1 b1 m1 w1 g -> + unGet x s1 b1 m1 w1 kf $ \ s2 b2 m2 w2 y -> ks s2 b2 m2 w2 (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 + m *> k = Get $ \ s0 b0 m0 w0 kf ks -> + unGet m s0 b0 m0 w0 kf $ \ s1 b1 m1 w1 _ -> unGet k s1 b1 m1 w1 kf ks {-# INLINE (*>) #-} instance A.Alternative Get where @@ -218,8 +219,8 @@ 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 + m >>= g = Get $ \ s0 b0 m0 w0 kf ks -> + unGet m s0 b0 m0 w0 kf $ \ s1 b1 m1 w1 a -> unGet (g a) s1 b1 m1 w1 kf ks {-# INLINE (>>=) #-} (>>) = (A.*>) @@ -235,15 +236,15 @@ instance M.MonadPlus Get where mzero = failDesc "mzero" {-# INLINE mzero #-} - +-- TODO: Test this! mplus a b = - Get $ \s0 b0 m0 kf ks -> + Get $ \s0 b0 m0 w0 kf ks -> let ks' s1 b1 = ks s1 (b0 `append` b1) kf' _ b1 m1 = kf (s0 `B.append` bufferBytes b1) (b0 `append` b1) m1 try _ b1 m1 _ _ = unGet b (s0 `B.append` bufferBytes b1) - b1 m1 kf' ks' - in unGet a s0 emptyBuffer m0 try ks' + b1 m1 w0 kf' ks' + in unGet a s0 emptyBuffer m0 w0 try ks' {-# INLINE mplus #-} @@ -254,21 +255,21 @@ formatTrace ls = "From:\t" ++ intercalate "\n\t" ls ++ "\n" get :: Get B.ByteString -get = Get (\s0 b0 m0 _ k -> k s0 b0 m0 s0) +get = Get (\s0 b0 m0 w _ k -> k s0 b0 m0 w s0) {-# INLINE get #-} -put :: B.ByteString -> Get () -put s = Get (\_ b0 m _ k -> k s b0 m ()) +put :: B.ByteString -> Int -> Get () +put s !w = Get (\_ b0 m _ _ k -> k s b0 m w ()) {-# INLINE put #-} label :: String -> Get a -> Get a label l m = - Get $ \ s0 b0 m0 kf ks -> + Get $ \ s0 b0 m0 w0 kf ks -> let kf' s1 b1 m1 ls = kf s1 b1 m1 (l:ls) - in unGet m s0 b0 m0 kf' ks + in unGet m s0 b0 m0 w0 kf' ks finalK :: Success a a -finalK s _ _ a = Done a s +finalK s _ _ _ a = Done a s failK :: Failure a failK s b _ ls msg = @@ -277,7 +278,7 @@ -- | Run the Get monad applies a 'get'-based parser on the input ByteString runGet :: Get a -> B.ByteString -> Either String a runGet m str = - case unGet m str Nothing Complete failK finalK of + case unGet m str Nothing Complete 0 failK finalK of Fail i _ -> Left i Done a _ -> Right a Partial{} -> Left "Failed reading: Internal error: unexpected Partial." @@ -288,7 +289,7 @@ -- input is left. For example, with a lazy ByteString, the optional length -- represents the sum of the lengths of all remaining chunks. runGetChunk :: Get a -> Maybe Int -> B.ByteString -> Result a -runGetChunk m mbLen str = unGet m str Nothing (Incomplete mbLen) failK finalK +runGetChunk m mbLen str = unGet m str Nothing (Incomplete mbLen) 0 failK finalK {-# INLINE runGetChunk #-} -- | Run the Get monad applies a 'get'-based parser on the input ByteString @@ -312,7 +313,7 @@ runGetState' :: Get a -> B.ByteString -> Int -> (Either String a, B.ByteString) runGetState' m str off = - case unGet m (B.drop off str) Nothing Complete failK finalK of + case unGet m (B.drop off str) Nothing Complete 0 failK finalK of Fail i bs -> (Left i,bs) Done a bs -> (Right a, bs) Partial{} -> (Left "Failed reading: Internal error: unexpected Partial.",B.empty) @@ -336,7 +337,6 @@ loop result chunks = case result of Fail str rest -> (Left str, L.fromChunks (rest : chunks)) - Partial k -> case chunks of c:cs -> loop (k c) cs [] -> loop (k B.empty) [] @@ -364,19 +364,18 @@ -- input, otherwise fail. {-# INLINE ensure #-} ensure :: Int -> Get B.ByteString -ensure n0 = n0 `seq` Get $ \ s0 b0 m0 kf ks -> let +ensure n0 = n0 `seq` Get $ \ s0 b0 m0 w0 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 + then ks s0 b0 m0 w0 s0 + else getMore n' s0 [] b0 m0 w0 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 + getMore !n s0 ss b0 m0 w0 kf ks = let tooFewBytes = let !s = finalInput s0 ss !b = finalBuffer b0 s0 ss @@ -390,16 +389,16 @@ !mb' = case mb of Just l -> Just $! l - B.length s Nothing -> Nothing - in checkIfEnough n s (s0 : ss) b0 (Incomplete mb') kf ks + in checkIfEnough n s (s0 : ss) b0 (Incomplete mb') w0 kf ks - checkIfEnough !n s0 ss b0 m0 kf ks = let + checkIfEnough !n s0 ss b0 m0 w0 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 + in ks s b m0 w0 s + else getMore n' s0 ss b0 m0 w0 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. @@ -408,48 +407,52 @@ M.when (n < 0) (fail "Attempted to isolate a negative number of bytes") s <- ensure n let (s',rest) = B.splitAt n s - put s' + cur <- bytesRead + put s' cur a <- m used <- get unless (B.null used) (fail "not all bytes parsed in isolate") - put rest + put rest (cur + n) return a failDesc :: String -> Get a failDesc err = do let msg = "Failed reading: " ++ err - Get (\s0 b0 m0 kf _ -> kf s0 b0 m0 [] msg) + Get (\s0 b0 m0 _ kf _ -> kf s0 b0 m0 [] msg) -- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available. skip :: Int -> Get () skip n = do s <- ensure n - put (B.drop n s) + cur <- bytesRead + put (B.drop n s) (cur + n) -- | Skip ahead up to @n@ bytes in the current chunk. No error if there aren't -- enough bytes, or if less than @n@ bytes are skipped. uncheckedSkip :: Int -> Get () uncheckedSkip n = do s <- get - put (B.drop n s) + cur <- bytesRead + put (B.drop n s) (cur + n) -- | Run @ga@, but return without consuming its input. -- Fails if @ga@ fails. lookAhead :: Get a -> Get a -lookAhead ga = Get $ \ s0 b0 m0 kf ks -> +lookAhead ga = Get $ \ s0 b0 m0 w0 kf ks -> -- the new continuation extends the old input with the new buffered bytes, and -- appends the new buffer to the old one, if there was one. let ks' _ b1 = ks (s0 `B.append` bufferBytes b1) (b0 `append` b1) kf' _ b1 = kf s0 (b0 `append` b1) - in unGet ga s0 emptyBuffer m0 kf' ks' + in unGet ga s0 emptyBuffer m0 w0 kf' ks' -- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'. -- Fails if @gma@ fails. lookAheadM :: Get (Maybe a) -> Get (Maybe a) lookAheadM gma = do s <- get + pre <- bytesRead ma <- gma - M.when (isNothing ma) (put s) + M.when (isNothing ma) (put s pre) return ma -- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'. @@ -457,9 +460,10 @@ lookAheadE :: Get (Either a b) -> Get (Either a b) lookAheadE gea = do s <- get + pre <- bytesRead ea <- gea case ea of - Left _ -> put s + Left _ -> put s pre _ -> return () return ea @@ -479,14 +483,14 @@ -- WARNING: when run with @runGetPartial@, remaining will only return the number -- of bytes that are remaining in the current input. remaining :: Get Int -remaining = Get (\ s0 b0 m0 _ ks -> ks s0 b0 m0 (B.length s0 + moreLength m0)) +remaining = Get (\ s0 b0 m0 w0 _ ks -> ks s0 b0 m0 w0 (B.length s0 + moreLength m0)) -- | Test whether all input has been consumed. -- -- WARNING: when run with @runGetPartial@, isEmpty will only tell you if you're -- at the end of the current chunk. isEmpty :: Get Bool -isEmpty = Get (\ s0 b0 m0 _ ks -> ks s0 b0 m0 (B.null s0 && moreLength m0 == 0)) +isEmpty = Get (\ s0 b0 m0 w0 _ ks -> ks s0 b0 m0 w0 (B.null s0 && moreLength m0 == 0)) ------------------------------------------------------------------------ -- Utility with ByteStrings @@ -520,7 +524,8 @@ let consume = B.unsafeTake n s rest = B.unsafeDrop n s -- (consume,rest) = B.splitAt n s - put rest + cur <- bytesRead + put rest (cur + n) return consume {-# INLINE getBytes #-} @@ -704,7 +709,7 @@ getWord32host :: Get Word32 getWord32host = getPtr (sizeOf (undefined :: Word32)) --- | /O(1)./ Read a Word64 in native host order and host endianess. +-- | /O(1)./ Read a Word64 in native host order and host endianness. getWord64host :: Get Word64 getWord64host = getPtr (sizeOf (undefined :: Word64)) @@ -825,3 +830,7 @@ getNested getLen getVal = do n <- getLen isolate n getVal + +-- | Get the number of bytes read up to this point +bytesRead :: Get Int +bytesRead = Get (\i b m w _ k -> k i b m w w) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cereal-0.5.4.0/src/Data/Serialize/Put.hs new/cereal-0.5.5.0/src/Data/Serialize/Put.hs --- old/cereal-0.5.4.0/src/Data/Serialize/Put.hs 2016-11-09 01:40:53.000000000 +0100 +++ new/cereal-0.5.5.0/src/Data/Serialize/Put.hs 2018-01-22 23:50:15.000000000 +0100 @@ -97,6 +97,9 @@ import qualified Control.Applicative as A import Data.Array.Unboxed +#if MIN_VERSION_base(4,9,0) +import qualified Data.Semigroup as M +#endif import qualified Data.Monoid as M import qualified Data.Foldable as F import Data.Word @@ -175,12 +178,20 @@ (>>) = (*>) {-# INLINE (>>) #-} +#if MIN_VERSION_base(4,9,0) +instance M.Semigroup (PutM ()) where + (<>) = (*>) + {-# INLINE (<>) #-} +#endif + instance Monoid (PutM ()) where mempty = pure () {-# INLINE mempty #-} +#if !(MIN_VERSION_base(4,11,0)) mappend = (*>) {-# INLINE mappend #-} +#endif tell :: Putter Builder tell b = Put $! PairS () b diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cereal-0.5.4.0/src/Data/Serialize.hs new/cereal-0.5.5.0/src/Data/Serialize.hs --- old/cereal-0.5.4.0/src/Data/Serialize.hs 2016-11-09 01:40:53.000000000 +0100 +++ new/cereal-0.5.5.0/src/Data/Serialize.hs 2018-01-22 23:50:15.000000000 +0100 @@ -254,7 +254,9 @@ put n = do putWord8 1 put sign - put (unroll (abs n)) -- unroll the bytes + let len = ((nrBits (abs n) + 7) `div` 8) + putWord64be (fromIntegral len) + mapM_ put (unroll (abs n)) -- unroll the bytes where sign = fromIntegral (signum n) :: Word8 @@ -281,6 +283,17 @@ where unstep b a = a `shiftL` 8 .|. fromIntegral b +nrBits :: (Ord a, Integral a) => a -> Int +nrBits k = + let expMax = until (\e -> 2 ^ e > k) (* 2) 1 + findNr :: Int -> Int -> Int + findNr lo hi + | mid == lo = hi + | 2 ^ mid <= k = findNr mid hi + | 2 ^ mid > k = findNr lo mid + where mid = (lo + hi) `div` 2 + in findNr (expMax `div` 2) expMax + instance (Serialize a,Integral a) => Serialize (R.Ratio a) where put r = put (R.numerator r) >> put (R.denominator r) get = liftM2 (R.%) get get @@ -299,7 +312,9 @@ put n = do putWord8 1 - put (unroll (abs n)) -- unroll the bytes + let len = ((nrBits (abs n) + 7) `div` 8) + putWord64be (fromIntegral len) + mapM_ put (unroll (abs n)) -- unroll the bytes {-# INLINE get #-} get = do
