cereal 0.5.4.0 → 0.5.5.0

raw patch · 5 files changed

+93/−52 lines, 5 filesdep ~basenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• cereal.cabal +1/−1
• src/Data/Serialize.hs +17/−2
• src/Data/Serialize/Get.hs +58/−49
• src/Data/Serialize/Put.hs +11/−0

@@ -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 ====== 

@@ -1,5 +1,5 @@ name:                   cereal-version:                0.5.4.0+version:                0.5.5.0 license:                BSD3 license-file:           LICENSE author:                 Lennart Kolmodin <kolmodin@dtek.chalmers.se>,

@@ -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

@@ -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)

@@ -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