cereal 0.3.0.0 → 0.3.1.0

raw patch · 6 files changed

+120/−59 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cereal.cabal +4/−2
• src/Data/Serialize/Get.hs +93/−27
• src/Data/Serialize/Put.hs +1/−1
• tests/Benchmark.hs +1/−0
• tests/Makefile +5/−1
• tests/Tests.hs +16/−28

@@ -1,8 +1,10 @@ name:                   cereal-version:                0.3.0.0+version:                0.3.1.0 license:                BSD3 license-file:           LICENSE-author:                 Lennart Kolmodin <kolmodin@dtek.chalmers.se>, Galois Inc.+author:                 Lennart Kolmodin <kolmodin@dtek.chalmers.se>,+                        Galois Inc.,+                        Lemmih <lemmih@gmail.com> maintainer:             Trevor Elliott <trevor@galois.com> category:               Data, Parsing stability:              provisional

@@ -27,8 +27,11 @@       Get     , runGet     , runGetState+    , Result(..)+    , runGetPartial      -- * Parsing+    , ensure     , isolate     , label     , skip@@ -91,6 +94,7 @@  import qualified Data.ByteString          as B import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe   as B import qualified Data.ByteString.Lazy     as L import qualified Data.IntMap              as IntMap import qualified Data.IntSet              as IntSet@@ -105,18 +109,47 @@ import GHC.Word #endif -type Failure   r = [String]     -> String -> Either String (r, B.ByteString)-type Success a r = B.ByteString -> a      -> Either String (r, B.ByteString)+type Failure   r = [String]     -> String -> Result r+type Success a r = B.ByteString -> More -> a      -> Result r +-- | The result of a parse.+data Result r = Fail String+              -- ^ The parse failed. The 'String' is the+              --   message describing the error, if any.+              | Partial (B.ByteString -> Result r)+              -- ^ Supply this continuation with more input so that+              --   the parser can resume. To indicate that no more+              --   input is available, use an 'B.empty' string.+              | Done r B.ByteString+              -- ^ The parse succeeded.  The 'B.ByteString' is the+              --   input that had not yet been consumed (if any) when+              --   the parse succeeded.++instance Show r => Show (Result r) where+    show (Fail msg)  = "Fail " ++ show msg+    show (Partial _) = "Partial _"+    show (Done r bs) = "Done " ++ show r ++ " " ++ show bs++instance Functor Result where+    fmap _ (Fail msg)  = Fail msg+    fmap f (Partial k) = Partial (fmap f . k)+    fmap f (Done r bs) = Done (f r) bs+ -- | The Get monad is an Exception and State monad. newtype Get a = Get   { unGet :: forall r. B.ByteString+                    -> More                     -> Failure   r                     -> Success a r-                    -> Either String (r, B.ByteString) }+                   -- -> Either String (r, B.ByteString) }+                    -> Result r } +-- | Have we read all available input?+data More = Complete | Incomplete+    deriving (Eq)+ instance Functor Get where-    fmap p m = Get (\s0 f k -> unGet m s0 f (\s a -> k s (p a)))+    fmap p m = Get (\s0 m0 f k -> unGet m s0 m0 f (\s m1 a -> k s m1 (p a)))  instance Applicative Get where     pure  = return@@ -128,13 +161,13 @@  -- Definition directly from Control.Monad.State.Strict instance Monad Get where-    return a = Get (\s0 _ k -> k s0 a)-    m >>= g  = Get (\s0 f k -> unGet m s0 f (\s a -> unGet (g a) s f k))+    return a = Get (\s0 m _ k -> k s0 m a)+    m >>= g  = Get (\s0 m0 f k -> unGet m s0 m0 f (\s m1 a -> unGet (g a) s m1 f k))     fail     = failDesc  instance MonadPlus Get where     mzero = failDesc "mzero"-    mplus a b = Get (\s0 f k -> unGet a s0 (\_ _ -> unGet b s0 f k) k)+    mplus a b = Get (\s0 m0 f k -> unGet a s0 m0 (\_ _ -> unGet b s0 m0 f k) k)  ------------------------------------------------------------------------ @@ -143,48 +176,70 @@ formatTrace ls = "From:\t" ++ intercalate "\n\t" ls ++ "\n"  get :: Get B.ByteString-get  = Get (\s0 _ k -> k s0 s0)+get  = Get (\s0 m0 _ k -> k s0 m0 s0)  put :: B.ByteString -> Get ()-put s = Get (\_ _ k -> k s ())+put s = Get (\_ m _ k -> k s m ())  label :: String -> Get a -> Get a-label l m = Get (\s0 f k -> unGet m s0 (\ls -> f (l:ls)) k)+label l m = Get (\s0 m0 f k -> unGet m s0 m0 (\ls -> f (l:ls)) k)  finalK :: Success a a-finalK s a = Right (a,s)+finalK s _ a = Done a s  failK :: Failure a-failK ls s = Left (unlines [s, formatTrace ls])+failK ls s = Fail (unlines [s, formatTrace ls])  -- | 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 failK finalK of-  Left  i      -> Left i-  Right (a, _) -> Right a+runGet m str = case unGet m str Complete failK finalK of+  Fail i    -> Left i+  Done a _  -> Right a+  Partial{} -> Left "Failed reading: Internal error: unexpected Partial." {-# INLINE runGet #-} +-- | Run the Get monad applies a 'get'-based parser on the input ByteString+runGetPartial :: Get a -> B.ByteString -> Result a+runGetPartial m str = unGet m str Incomplete failK finalK+{-# INLINE runGetPartial #-}+ -- | Run the Get monad applies a 'get'-based parser on the input -- ByteString. Additional to the result of get it returns the number of -- consumed bytes and the rest of the input. runGetState :: Get a -> B.ByteString -> Int             -> Either String (a, B.ByteString) runGetState m str off =-    case unGet m (B.drop off str) failK finalK of-      Left i        -> Left i-      Right (a, bs) -> Right (a, bs)+    case unGet m (B.drop off str) Complete failK finalK of+      Fail i      -> Left i+      Done a bs   -> Right (a, bs)+      Partial{}   -> Left "Failed reading: Internal error: unexpected Partial." {-# INLINE runGetState #-}  ------------------------------------------------------------------------ +-- | 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 $ \i0 m0 kf ks ->+    if B.length i0 >= n+    then ks i0 m0 i0+    else unGet (demandInput >> ensureRec n) i0 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 $ \i0 m0 kf ks ->+    if B.length i0 >= n+    then ks i0 m0 i0+    else unGet (demandInput >> ensureRec n) i0 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. isolate :: Int -> Get a -> Get a isolate n m = do   when (n < 0) (fail "Attempted to isolate a negative number of bytes")-  s <- get-  let left = B.length s-  unless (n <= left) (fail "not enough space left to isolate")+  s <- ensure n   let (s',rest) = B.splitAt n s   put s'   a    <- m@@ -193,16 +248,26 @@   put rest   return a +-- | Immediately demand more input via a 'Partial' continuation+--   result.+demandInput :: Get ()+demandInput = Get $ \i0 m0 kf ks ->+    if m0 == Complete+    then kf ["demandInput"] "too few bytes"+    else Partial $ \s ->+         if B.null s+         then kf ["demandInput"] "too few bytes"+         else ks (i0 `B.append` s) Incomplete ()+ failDesc :: String -> Get a failDesc err = do     let msg = "Failed reading: " ++ err-    Get (\_ f _ -> f [] msg)+    Get (\_ _ f _ -> f [] msg)  -- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available. skip :: Int -> Get () skip n = do-  s <- get-  when (B.length s < n) (fail "too few bytes")+  s <- ensure n   put (B.drop n s)  -- | Skip ahead @n@ bytes. No error if there isn't enough bytes.@@ -282,9 +347,10 @@ -- | Pull @n@ bytes from the input, as a strict ByteString. getBytes :: Int -> Get B.ByteString getBytes n = do-    s <- get-    when (n > B.length s) (fail "too few bytes")-    let (consume,rest) = B.splitAt n s+    s <- ensure n+    let consume = B.unsafeTake n s+        rest    = B.unsafeDrop n s+        -- (consume,rest) = B.splitAt n s     put rest     return consume 

@@ -8,7 +8,7 @@ -- Stability   : -- Portability : ----- The Put monad. A monad for efficiently constructing lazy bytestrings.+-- The Put monad. A monad for efficiently constructing bytestrings. -- ----------------------------------------------------------------------------- 

@@ -7,6 +7,7 @@ import Data.Serialize.Get  import Control.Exception+import Data.Word import System.CPUTime import Numeric import Text.Printf

@@ -1,10 +1,14 @@-GHC	= ghc -O2 -fasm -fforce-recomp+GHC	= ghc -O2 -fasm -fforce-recomp -i../src -prof  all: bench qc  bench:: Benchmark.hs MemBench.hs CBenchmark.o 	$(GHC) -fliberate-case-threshold=1000 --make Benchmark.hs CBenchmark.o -o $@ 	./$@ 100++bench-prof: Benchmark.hs MemBench.hs CBenchmark.o+	$(GHC) -auto-all -rtsopts -fliberate-case-threshold=1000 --make Benchmark.hs CBenchmark.o -o $@+	./$@ 100 +RTS -p  CBenchmark.o: CBenchmark.c 	gcc -O3 -c $< -o $@

@@ -14,20 +14,8 @@ import Data.Serialize import Data.Serialize.Get import Data.Serialize.Put-import Data.Word (Word8)-import Test.QuickCheck--instance Arbitrary Word8 where-  arbitrary = arbitraryBoundedIntegral--instance Arbitrary Word16 where-  arbitrary = arbitraryBoundedIntegral--instance Arbitrary Word32 where-  arbitrary = arbitraryBoundedIntegral--instance Arbitrary Word64 where-  arbitrary = arbitraryBoundedIntegral+import Data.Word (Word8,Word16,Word32,Word64)+import Test.QuickCheck as QC   roundTrip :: Eq a => Putter a -> Get a -> a -> Bool@@ -36,25 +24,25 @@  main :: IO () main  = mapM_ quickCheck-  [ label "Word8         Round Trip" $ roundTrip putWord8      getWord8-  , label "Word16be      Round Trip" $ roundTrip putWord16be   getWord16be-  , label "Word16le      Round Trip" $ roundTrip putWord16le   getWord16le-  , label "Word32be      Round Trip" $ roundTrip putWord32be   getWord32be-  , label "Word32le      Round Trip" $ roundTrip putWord32le   getWord32le-  , label "Word64be      Round Trip" $ roundTrip putWord64be   getWord64be-  , label "Word64le      Round Trip" $ roundTrip putWord64le   getWord64le-  , label "Word16host    Round Trip" $ roundTrip putWord16host getWord16host-  , label "Word32host    Round Trip" $ roundTrip putWord32host getWord32host-  , label "Word64host    Round Trip" $ roundTrip putWord64host getWord64host+  [ QC.label "Word8         Round Trip" $ roundTrip putWord8      getWord8+  , QC.label "Word16be      Round Trip" $ roundTrip putWord16be   getWord16be+  , QC.label "Word16le      Round Trip" $ roundTrip putWord16le   getWord16le+  , QC.label "Word32be      Round Trip" $ roundTrip putWord32be   getWord32be+  , QC.label "Word32le      Round Trip" $ roundTrip putWord32le   getWord32le+  , QC.label "Word64be      Round Trip" $ roundTrip putWord64be   getWord64be+  , QC.label "Word64le      Round Trip" $ roundTrip putWord64le   getWord64le+  , QC.label "Word16host    Round Trip" $ roundTrip putWord16host getWord16host+  , QC.label "Word32host    Round Trip" $ roundTrip putWord32host getWord32host+  , QC.label "Word64host    Round Trip" $ roundTrip putWord64host getWord64host      -- Containers-  , label "(Word8,Word8) Round Trip"+  , QC.label "(Word8,Word8) Round Trip"     $ roundTrip (putTwoOf putWord8 putWord8) (getTwoOf getWord8 getWord8)-  , label "[Word8] Round Trip"+  , QC.label "[Word8] Round Trip"     $ roundTrip (putListOf putWord8) (getListOf getWord8)-  , label "Maybe Word8 Round Trip"+  , QC.label "Maybe Word8 Round Trip"     $ roundTrip (putMaybeOf putWord8) (getMaybeOf getWord8)-  , label "Either Word8 Word16be Round Trip "+  , QC.label "Either Word8 Word16be Round Trip "     $ roundTrip (putEitherOf putWord8 putWord16be)                 (getEitherOf getWord8 getWord16be)   ]