diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,78 +0,0 @@ - - binary: efficient, pure binary serialisation using lazy ByteStrings ------------------------------------------------------------------------- - -The 'binary' package provides Data.Binary, containing the Binary class, -and associated methods, for serialising values to and from lazy -ByteStrings. - -A key feature of 'binary' is that the interface is both pure, and efficient. - -The 'binary' package is portable to GHC and Hugs. - -Building: - - runhaskell Setup.lhs configure - runhaskell Setup.lhs build - runhaskell Setup.lhs install - -First: - import Data.Binary - -and then write an instance of Binary for the type you wish to serialise. -More information in the haddock documentation. - -Deriving: - -It is possible to mechanically derive new instances of Binary for your -types, if they support the Data and Typeable classes. A script is -provided in tools/derive. Here's an example of its use. - - $ cd binary - $ cd tools/derive - - $ ghci -fglasgow-exts BinaryDerive.hs - - *BinaryDerive> :l Example.hs - - *Main> deriveM (undefined :: Exp) - - instance Binary Main.Exp where - put (ExpOr a b) = putWord8 0 >> put a >> put b - put (ExpAnd a b) = putWord8 1 >> put a >> put b - put (ExpEq a b) = putWord8 2 >> put a >> put b - put (ExpNEq a b) = putWord8 3 >> put a >> put b - put (ExpAdd a b) = putWord8 4 >> put a >> put b - put (ExpSub a b) = putWord8 5 >> put a >> put b - put (ExpVar a) = putWord8 6 >> put a - put (ExpInt a) = putWord8 7 >> put a - get = do - tag_ <- getWord8 - case tag_ of - 0 -> get >>= \a -> get >>= \b -> return (ExpOr a b) - 1 -> get >>= \a -> get >>= \b -> return (ExpAnd a b) - 2 -> get >>= \a -> get >>= \b -> return (ExpEq a b) - 3 -> get >>= \a -> get >>= \b -> return (ExpNEq a b) - 4 -> get >>= \a -> get >>= \b -> return (ExpAdd a b) - 5 -> get >>= \a -> get >>= \b -> return (ExpSub a b) - 6 -> get >>= \a -> return (ExpVar a) - 7 -> get >>= \a -> return (ExpInt a) - _ -> fail "no decoding" - -Contributors: - - Lennart Kolmodin - Duncan Coutts - Don Stewart - Spencer Janssen - David Himmelstrup - Björn Bringert - Ross Paterson - Einar Karttunen - John Meacham - Ulf Norell - Tomasz Zielonka - Stefan Karrmann - Bryan O'Sullivan - Bas van Dijk - Florian Weimer diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,108 @@ +# binary package # + +*Efficient, pure binary serialisation using lazy ByteStrings.* + +The ``binary`` package provides Data.Binary, containing the Binary class, +and associated methods, for serialising values to and from lazy +ByteStrings. +A key feature of ``binary`` is that the interface is both pure, and efficient. +The ``binary`` package is portable to GHC and Hugs. + +## Installing binary from Hackage ## + +``binary`` is part of The Glasgow Haskell Compiler (GHC) and therefore if you +have either GHC or [The Haskell Platform](http://www.haskell.org/platform/) +installed, you already have ``binary``. + +More recent versions of ``binary`` than you might have installed may be +available. You can use ``cabal-install`` to install a later version from +[Hackage](http://hackage.haskell.org/package/binary). + + $ cabal update + $ cabal install binary + +## Building binary ## + +``binary`` comes with both a test suite and a set of benchmarks. +While developing, you probably want to enable both. +Here's how to get the latest version of the repository, configure and build. + + $ git clone git@github.com:kolmodin/binary.git + $ cd binary + $ cabal update + $ cabal configure --enable-tests --enable-benchmarks + $ cabal build + +Run the test suite. + + $ cabal test + +## Using binary ## + +First: + + import Data.Binary + +and then write an instance of Binary for the type you wish to serialise. +An example doing exactly this can be found in the Data.Binary module. +You can also use the Data.Binary.Builder module to efficiently build +lazy bytestrings using the ``Builder`` monoid. Or, alternatively, the +Data.Binary.Get and Data.Binary.Put to serialize/deserialize using +the ``Get`` and ``Put`` monads. + +More information in the haddock documentation. + +## Deriving binary instances ## + +It is possible to mechanically derive new instances of Binary for your +types, if they support the Data and Typeable classes. A script is +provided in tools/derive. Here's an example of its use. + + $ cd binary + $ cd tools/derive + + $ ghci -fglasgow-exts BinaryDerive.hs + + *BinaryDerive> :l Example.hs + + *Main> deriveM (undefined :: Exp) + + instance Binary Main.Exp where + put (ExpOr a b) = putWord8 0 >> put a >> put b + put (ExpAnd a b) = putWord8 1 >> put a >> put b + put (ExpEq a b) = putWord8 2 >> put a >> put b + put (ExpNEq a b) = putWord8 3 >> put a >> put b + put (ExpAdd a b) = putWord8 4 >> put a >> put b + put (ExpSub a b) = putWord8 5 >> put a >> put b + put (ExpVar a) = putWord8 6 >> put a + put (ExpInt a) = putWord8 7 >> put a + get = do + tag_ <- getWord8 + case tag_ of + 0 -> get >>= \a -> get >>= \b -> return (ExpOr a b) + 1 -> get >>= \a -> get >>= \b -> return (ExpAnd a b) + 2 -> get >>= \a -> get >>= \b -> return (ExpEq a b) + 3 -> get >>= \a -> get >>= \b -> return (ExpNEq a b) + 4 -> get >>= \a -> get >>= \b -> return (ExpAdd a b) + 5 -> get >>= \a -> get >>= \b -> return (ExpSub a b) + 6 -> get >>= \a -> return (ExpVar a) + 7 -> get >>= \a -> return (ExpInt a) + _ -> fail "no decoding" + +## Contributors ## + +* Lennart Kolmodin +* Duncan Coutts +* Don Stewart +* Spencer Janssen +* David Himmelstrup +* Björn Bringert +* Ross Paterson +* Einar Karttunen +* John Meacham +* Ulf Norell +* Tomasz Zielonka +* Stefan Karrmann +* Bryan O'Sullivan +* Bas van Dijk +* Florian Weimer diff --git a/benchmarks/Get.hs b/benchmarks/Get.hs --- a/benchmarks/Get.hs +++ b/benchmarks/Get.hs @@ -53,8 +53,10 @@ whnf (checkBracket . runAttoL bracketParser_atto) brackets , bench "Attoparsec lazy-bs brackets 100kb in 100 byte chunks" $ whnf (checkBracket . runAttoL bracketParser_atto) bracketsInChunks - , bench "Attoparsec strict-bs brackets 10M0kb one chunk" $ + , bench "Attoparsec strict-bs brackets 100kb" $ whnf (checkBracket . runAtto bracketParser_atto) $ S.concat (L.toChunks brackets) + , bench "Cereal strict-bs brackets 100kb" $ + whnf (checkBracket . runCereal bracketParser_cereal) $ S.concat (L.toChunks brackets) , bench "Binary getStruct4 1MB struct of 4 word8" $ whnf (runTest (getStruct4 mega)) oneMegabyteLBS , bench "Cereal getStruct4 1MB struct of 4 word8" $ @@ -89,7 +91,9 @@ | otherwise = error "argh!" runTest decoder inp = runGet decoder inp -runCereal decoder inp = Cereal.runGet decoder inp +runCereal decoder inp = case Cereal.runGet decoder inp of + Right a -> a + Left err -> error err runAtto decoder inp = case A.parseOnly decoder inp of Right a -> a Left err -> error err @@ -125,6 +129,15 @@ cont = do v <- some ( do 40 <- getWord8 n <- many cont 41 <- getWord8 + return $! sum n + 1) + return $! sum v + +bracketParser_cereal :: Cereal.Get Int +bracketParser_cereal = cont <|> return 0 + where + cont = do v <- some ( do 40 <- Cereal.getWord8 + n <- many cont + 41 <- Cereal.getWord8 return $! sum n + 1) return $! sum v diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.7.0.1 +version: 0.7.1.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin @@ -20,7 +20,7 @@ cabal-version: >= 1.8 tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.6.1 extra-source-files: - README index.html docs/hcar/binary-Lb.tex + README.md index.html docs/hcar/binary-Lb.tex tools/derive/*.hs tests/Makefile benchmarks/Makefile -- from the benchmark 'bench' @@ -70,7 +70,7 @@ containers, random>=1.0.1.0, test-framework, - test-framework-quickcheck2, + test-framework-quickcheck2 >= 0.3, QuickCheck>=2.5 ghc-options: -Wall -O2 diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -146,6 +146,7 @@ , bytesRead , lookAhead , lookAheadM + , lookAheadE -- ** ByteStrings , getByteString diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs --- a/src/Data/Binary/Get/Internal.hs +++ b/src/Data/Binary/Get/Internal.hs @@ -30,6 +30,7 @@ , isEmpty , lookAhead , lookAheadM + , lookAheadE -- ** ByteStrings , getByteString @@ -42,6 +43,7 @@ import qualified Data.ByteString.Unsafe as B import Control.Applicative +import Control.Monad #if __GLASGOW_HASKELL__ < 704 && !defined(__HADDOCK__) -- needed for (# unboxing #) with magic hash @@ -58,7 +60,7 @@ -- rare, as the RTS should only wake you up if you actually have some data -- to read from your fd. --- | A decoder procuced by running a 'Get' monad. +-- | A decoder produced by running a 'Get' monad. data Decoder a = Fail !B.ByteString String -- ^ The decoder ran into an error. The decoder either used -- 'fail' or was not provided enough input. @@ -116,6 +118,10 @@ (<*>) = apG {-# INLINE (<*>) #-} +instance MonadPlus Get where + mzero = empty + mplus = (<|>) + instance Functor Get where fmap = fmapG @@ -248,10 +254,18 @@ -- If the given decoder fails, then so will this function. lookAheadM :: Get (Maybe a) -> Get (Maybe a) lookAheadM g = do + let g' = maybe (Left ()) Right <$> g + either (const Nothing) Just <$> lookAheadE g' + +-- | Run the given decoder, and only consume its input if it returns 'Right'. +-- If 'Left' is returned, the input will be unconsumed. +-- If the given decoder fails, then so will this function. +lookAheadE :: Get (Either a b) -> Get (Either a b) +lookAheadE g = do (decoder, bs) <- runAndKeepTrack g case decoder of - Done _ Nothing -> pushBack bs >> return Nothing - Done inp (Just x) -> C $ \_ ks -> ks inp (Just x) + Done _ (Left x) -> pushBack bs >> return (Left x) + Done inp (Right x) -> C $ \_ ks -> ks inp (Right x) Fail inp s -> C $ \_ _ -> Fail inp s _ -> error "Binary: impossible" diff --git a/tests/Action.hs b/tests/Action.hs --- a/tests/Action.hs +++ b/tests/Action.hs @@ -4,6 +4,7 @@ import Control.Applicative import Control.Monad import Test.QuickCheck +import Data.Maybe ( fromJust ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L @@ -19,6 +20,8 @@ | LookAhead [Action] -- | First argument is True if this action returns Just, otherwise False. | LookAheadM Bool [Action] + -- | First argument is True if this action returns Right, otherwise Left. + | LookAheadE Bool [Action] | BytesRead | Fail deriving (Show, Eq) @@ -33,6 +36,7 @@ Fail -> [] LookAhead a -> Actions a : [ LookAhead a' | a' <- shrink a ] LookAheadM b a -> Actions a : [ LookAheadM b a' | a' <- shrink a] + LookAheadE b a -> Actions a : [ LookAheadE b a' | a' <- shrink a] Try [Fail] b -> Actions b : [ Try [Fail] b' | b' <- shrink b ] Try a b -> (if not (willFail a) then [Actions a] else []) @@ -49,9 +53,13 @@ Try a b -> (willFail a && willFail b) || willFail xs LookAhead a -> willFail a || willFail xs LookAheadM _ a -> willFail a || willFail xs + LookAheadE _ a -> willFail a || willFail xs BytesRead -> willFail xs Fail -> True +-- | The maximum length of input decoder can request. +-- The decoder may end up using less, but never more. +-- This way, you know how much input to generate for running a decoder test. max_len :: [Action] -> Int max_len [] = 0 max_len (x:xs) = @@ -65,7 +73,12 @@ LookAheadM b a | willFail a -> max_len a | b -> max_len a + max_len xs | otherwise -> max (max_len a) (max_len xs) + LookAheadE b a | willFail a -> max_len a + | b -> max_len a + max_len xs + | otherwise -> max (max_len a) (max_len xs) +-- | The actual length of input that will be consumed when +-- a decoder is executed, or Nothing if the decoder will fail. actual_len :: [Action] -> Maybe Int actual_len [] = Just 0 actual_len (x:xs) = @@ -79,6 +92,9 @@ LookAheadM b a | willFail a -> Nothing | b -> (+) <$> actual_len a <*> rest | otherwise -> rest + LookAheadE b a | willFail a -> Nothing + | b -> (+) <$> actual_len a <*> rest + | otherwise -> rest Try a b | not (willFail a) -> (+) <$> actual_len a <*> rest | not (willFail b) -> (+) <$> actual_len b <*> rest | otherwise -> Nothing @@ -128,18 +144,27 @@ _ <- Binary.lookAhead (go pos a) go pos xs LookAheadM b a -> do - let f True = leg pos a + let f True = Just <$> leg pos a f False = go pos a >> return Nothing len <- Binary.lookAheadM (f b) case len of Nothing -> go pos xs Just offset -> go (pos+offset) xs - Try a b -> do - len <- leg pos a <|> leg pos b + LookAheadE b a -> do + let f True = Right <$> leg pos a + f False = go pos a >> return (Left ()) + len <- Binary.lookAheadE (f b) case len of - Nothing -> error "got Nothing, but we're still here..." - Just offset -> go (pos+offset) xs - leg pos t = go pos t >> return (actual_len t) + Left _ -> go pos xs + Right offset -> go (pos+offset) xs + Try a b -> do + offset <- leg pos a <|> leg pos b + go (pos+offset) xs + leg pos t = do + go pos t + case actual_len t of + Nothing -> error "impossible: branch should have failed" + Just offset -> return offset gen_actions :: Gen [Action] gen_actions = sized (go False) @@ -157,4 +182,7 @@ , do t <- go inTry (s`div`2) b <- arbitrary (:) (LookAheadM b t) <$> go inTry (s-1) + , do t <- go inTry (s`div`2) + b <- arbitrary + (:) (LookAheadE b t) <$> go inTry (s-1) ] ++ [ return [Fail] | inTry ]