cereal 0.3.5.1 → 0.3.5.2
raw patch · 5 files changed
+51/−28 lines, 5 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- cereal.cabal +2/−2
- src/Data/Serialize.hs +12/−3
- src/Data/Serialize/Builder.hs +5/−1
- src/Data/Serialize/Get.hs +15/−8
- src/Data/Serialize/Put.hs +17/−14
cereal.cabal view
@@ -1,5 +1,5 @@ name: cereal-version: 0.3.5.1+version: 0.3.5.2 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <kolmodin@dtek.chalmers.se>,@@ -27,7 +27,7 @@ source-repository head type: git- location: git://code.galois.com/cereal.git+ location: git://github.com/GaloisInc/cereal.git flag split-base default: True
src/Data/Serialize.hs view
@@ -364,12 +364,12 @@ -- ByteStrings (have specially efficient instances) instance Serialize B.ByteString where- put bs = do put (B.length bs)+ put bs = do put (B.length bs :: Int) putByteString bs get = get >>= getByteString instance Serialize L.ByteString where- put bs = do put (fromIntegral (L.length bs) :: Int)+ put bs = do put (L.length bs :: Int64) putLazyByteString bs get = get >>= getLazyByteString @@ -504,7 +504,11 @@ L1 x -> putSum code sizeL x R1 x -> putSum (code + sizeL) sizeR x where+#if MIN_VERSION_base(4,5,0)+ sizeL = size `unsafeShiftR` 1+#else sizeL = size `shiftR` 1+#endif sizeR = size - sizeL {-# INLINE putSum #-} @@ -514,7 +518,8 @@ ------------------------------------------------------------------------ -checkGetSum :: (Ord word, Bits word, GetSum f) => word -> word -> Get (f a)+checkGetSum :: (Ord word, Num word, Bits word, GetSum f)+ => word -> word -> Get (f a) checkGetSum size code | code < size = getSum code size | otherwise = fail "Unknown encoding for constructor" {-# INLINE checkGetSum #-}@@ -526,7 +531,11 @@ getSum !code !size | code < sizeL = L1 <$> getSum code sizeL | otherwise = R1 <$> getSum (code - sizeL) sizeR where+#if MIN_VERSION_base(4,5,0)+ sizeL = size `unsafeShiftR` 1+#else sizeL = size `shiftR` 1+#endif sizeR = size - sizeL {-# INLINE getSum #-}
src/Data/Serialize/Builder.hs view
@@ -57,7 +57,11 @@ ) where import Data.Monoid-import Foreign+import Data.Word+import Foreign.ForeignPtr+import Foreign.Ptr (Ptr,plusPtr)+import Foreign.Storable+import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Internal as S
src/Data/Serialize/Get.hs view
@@ -7,7 +7,7 @@ -- Module : Data.Serialize.Get -- Copyright : Lennart Kolmodin, Galois Inc. 2009 -- License : BSD3-style (see LICENSE)--- +-- -- Maintainer : Trevor Elliott <trevor@galois.com> -- Stability : -- Portability :@@ -260,12 +260,18 @@ remLen c = fromIntegral (L.length lstr) - B.length c run str = unGet m str Nothing (Incomplete (Just (remLen str))) failK finalK - loop _ [] =- (Left "Failed reading: Internal error: unexpected end of input",L.empty)- loop k (c:cs) = case k c of- Fail str -> (Left str,L.empty)- Partial k' -> loop k' cs- Done r c' -> (Right r,L.fromChunks (c':cs))+ loop k chunks = case chunks of++ c:cs -> case k c of+ Fail str -> (Left str,L.empty)+ Partial k' -> loop k' cs+ Done r c' -> (Right r,L.fromChunks (c':cs))++ [] -> case k B.empty of+ Fail str -> (Left str,L.empty)+ Partial k' -> (Left "Failed reading: Internal error: unexpected end of input",L.empty)+ Done r c' -> (Right r,L.empty)+ {-# INLINE runGetLazy' #-} -- | Run the Get monad over a Lazy ByteString. Note that this will not run the@@ -350,7 +356,7 @@ -- Fails if @ga@ fails. lookAhead :: Get a -> Get a lookAhead ga = Get $ \ s0 b0 m0 kf ks ->- let ks' s1 b1 = ks (s0 `B.append` bufferBytes b1) (b0 `append` b1)+ let ks' _s1 b1 = ks (s0 `B.append` bufferBytes b1) (b0 `append` b1) in unGet ga s0 (Just B.empty) m0 kf ks' -- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.@@ -418,6 +424,7 @@ -- | Pull @n@ bytes from the input, as a strict ByteString. getBytes :: Int -> Get B.ByteString+getBytes n | n < 0 = fail "getBytes: negative length requested" getBytes n = do s <- ensure n let consume = B.unsafeTake n s
src/Data/Serialize/Put.hs view
@@ -70,6 +70,7 @@ import Control.Applicative import Data.Array.Unboxed import Data.Monoid+import Data.Foldable (foldMap) import Data.Word import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -83,8 +84,8 @@ ------------------------------------------------------------------------ --- XXX Strict in buffer only. -data PairS a = PairS a {-# UNPACK #-}!Builder+-- XXX Strict in builder only. +data PairS a = PairS a !Builder sndS :: PairS a -> Builder sndS (PairS _ b) = b@@ -251,16 +252,18 @@ -- Containers ------------------------------------------------------------------ +encodeListOf :: (a -> Builder) -> [a] -> Builder+encodeListOf f = -- allow inlining with just a single argument+ \xs -> execPut (putWord64be (fromIntegral $ length xs)) `mappend`+ foldMap f xs+{-# INLINE encodeListOf #-}+ putTwoOf :: Putter a -> Putter b -> Putter (a,b) putTwoOf pa pb (a,b) = pa a >> pb b {-# INLINE putTwoOf #-} putListOf :: Putter a -> Putter [a]-putListOf pa = go 0 (return ())- where- go n body [] = putWord64be n >> body- go n body (x:xs) = n' `seq` go n' (body >> pa x) xs- where n' = n + 1+putListOf pa = tell . encodeListOf (execPut . pa) {-# INLINE putListOf #-} putIArrayOf :: (Ix i, IArray a e) => Putter i -> Putter e -> Putter (a i e)@@ -270,16 +273,16 @@ {-# INLINE putIArrayOf #-} putSeqOf :: Putter a -> Putter (Seq.Seq a)-putSeqOf pa = go 0 (return ())- where- go n body s = case Seq.viewl s of- Seq.EmptyL -> putWord64be n >> body- a Seq.:< as -> n' `seq` go n' (body >> pa a) as- where n' = n + 1+putSeqOf pa = \s -> do+ putWord64be (fromIntegral $ Seq.length s) + tell (foldMap (execPut . pa) s) {-# INLINE putSeqOf #-} putTreeOf :: Putter a -> Putter (T.Tree a)-putTreeOf pa (T.Node r s) = pa r >> putListOf (putTreeOf pa) s+putTreeOf pa = + tell . go+ where+ go (T.Node x cs) = execPut (pa x) `mappend` encodeListOf go cs {-# INLINE putTreeOf #-} putMapOf :: Ord k => Putter k -> Putter a -> Putter (Map.Map k a)