diff --git a/benchmarks/Makefile b/benchmarks/Makefile deleted file mode 100644 --- a/benchmarks/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -ghc := ghc -ghc-flags := -programs := builder bench - -SYSTEM_BINARY := binary-0.5.1.1 - -.PHONY: all -all: $(programs) - -builder: Builder.hs - $(ghc) $(ghc-flags) --make -O2 Builder.hs -o $@ -fforce-recomp -i../src - -get: Get.hs - $(ghc) $(ghc-flags) --make -O2 Get.hs -o $@ -fforce-recomp -i../src - -system-get: Get.hs - $(ghc) $(ghc-flags) --make -O2 Get.hs -o $@ -package $(SYSTEM_BINARY) - -bench: Benchmark.hs MemBench.hs CBenchmark.o - $(ghc) $(ghc-flags) --make -O2 -fliberate-case-threshold=1000 Benchmark.hs CBenchmark.o -o $@ -fforce-recomp -i../src - -system-bench: Benchmark.hs MemBench.hs CBenchmark.o - $(ghc) $(ghc-flags) --make -O2 -fliberate-case-threshold=1000 Benchmark.hs CBenchmark.o -o $@ -no-user-package-conf - -.PHONY: run-bench -run-bench: bench - ./bench 100 - -CBenchmark.o: CBenchmark.c - $(ghc) -c -optc -O3 $< -o $@ - -.PHONY: clean -clean: - rm -f *.o *.hi $(programs) diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.7.4.0 +version: 0.7.5.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin @@ -18,10 +18,9 @@ stability: provisional build-type: Simple cabal-version: >= 1.8 -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.2 +tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.2, GHC == 7.10.1 extra-source-files: - README.md index.html docs/hcar/binary-Lb.tex - tools/derive/*.hs tests/Makefile benchmarks/Makefile + README.md docs/hcar/binary-Lb.tex tools/derive/*.hs -- from the benchmark 'bench' extra-source-files: @@ -71,7 +70,7 @@ random>=1.0.1.0, test-framework, test-framework-quickcheck2 >= 0.3, - QuickCheck>=2.7 + QuickCheck>=2.8 -- build dependencies from using binary source rather than depending on the library build-depends: array, containers diff --git a/index.html b/index.html deleted file mode 100644 --- a/index.html +++ /dev/null @@ -1,161 +0,0 @@ - - - - - - Data.Binary - efficient, pure binary serialisation for Haskell - - - - - -
- -

Data.Binary

- -
- -

About

-

- Data.Binary is a library for high performance binary serialisation - of Haskell data. It uses the - ByteString library to achieve efficient, lazy reading and - writing of structures in binary format. -

- -

- Chris Eidhof writes on his use of Data.Binary implementing a - full-text search engine: -

- 
-   "The communication with Sphinx is done using a quite low-level binary
-    protocol, but Data.Binary saved the day: it made it very easy for us
-    to decode all the binary things. Especially the use of the Get and
-    Put monads are a big improvement over the manual reading and keeping
-    track of positions, as is done in the PHP/Python clients."
-
- -

Example

- For example, to serialise an interpreter's abstract syntax tree to - binary format: -
import Data.Binary
-import Control.Monad
-import Codec.Compression.GZip
-
--- A Haskell AST structure
-data Exp = IntE Int
-         | OpE  String Exp Exp
-   deriving Eq
-
--- An instance of Binary to encode and decode an Exp in binary
-instance Binary Exp where
-     put (IntE i)          = put (0 :: Word8) >> put i
-     put (OpE s e1 e2)     = put (1 :: Word8) >> put s >> put e1 >> put e2
-     get = do tag <- getWord8
-              case tag of
-                  0 -> liftM  IntE get
-                  1 -> liftM3 OpE  get get get
-
--- A test expression
-e = OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2))
-
--- Serialise and compress with gzip, then decompress and deserialise
-main = do
-    let t  = compress (encode e)
-    print t
-    let e' = decode (decompress t)
-    print (e == e')
-
- -

Download

- - - -

stable release

- - - - - - - - - - - -
- binary 0.4.2 - (Apr 2008)
- binary 0.4.1 - (Oct 2007)
- binary 0.4 - (Oct 2007)
- binary 0.3 - (Mar 2007)
- binary 0.2 - (Jan 2007)
-

development branch

- - -
- darcs get http://code.haskell.org/binary -
-
- -

Download

- - -

Project Activity

- -
- binary commit statistics -
- -

Starring...

- - The Binary Strike Force -
    -
  • Lennart Kolmodin
    • -
  • Duncan Coutts
    • -
  • Don Stewart
    • -
  • Spencer Janssen
    • -
  • David Himmelstrup
    • -
  • Björn Bringert
    • -
  • Ross Paterson
    • -
  • Einar Karttunen
    • -
  • John Meacham
    • -
  • Ulf Norell
    • -
  • Bryan O'Sullivan
    • -
  • Tomasz Zielonka
    • -
  • Florian Weimer
    • -
  • Judah Jacobson
    • -
- -
- -covered by HPC -built with Cabal -tested with QuickCheck - -
- - - - - - diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -537,11 +537,17 @@ instance Binary Double where put d = put (decodeFloat d) - get = liftM2 encodeFloat get get + get = do + x <- get + y <- get + return $! encodeFloat x y instance Binary Float where put f = put (decodeFloat f) - get = liftM2 encodeFloat get get + get = do + x <- get + y <- get + return $! encodeFloat x y ------------------------------------------------------------------------ -- Trees 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 @@ -360,59 +360,43 @@ Partial k -> k Nothing Fail _ _ _ -> r +-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available. +skip :: Int -> Get () +skip n = withInputChunks (fromIntegral n) consumeBytes (const ()) failOnEOF + -- | An efficient get method for lazy ByteStrings. Fails if fewer than @n@ -- bytes are left in the input. getLazyByteString :: Int64 -> Get L.ByteString -getLazyByteString n0 = L.fromChunks <$> go n0 - where - consume n str - | fromIntegral (B.length str) >= n = Right (B.splitAt (fromIntegral n) str) - | otherwise = Left (fromIntegral (B.length str)) - go n = do - str <- get - case consume n str of - Left used -> do - put B.empty - demandInput - fmap (str:) (go (n - used)) - Right (want,rest) -> do - put rest - return [want] +getLazyByteString n0 = withInputChunks n0 consumeBytes L.fromChunks failOnEOF +consumeBytes :: Consume Int64 +consumeBytes n str + | fromIntegral (B.length str) >= n = Right (B.splitAt (fromIntegral n) str) + | otherwise = Left (n - fromIntegral (B.length str)) + +consumeUntilNul :: Consume () +consumeUntilNul _ str = + case B.break (==0) str of + (want, rest) | B.null rest -> Left () + | otherwise -> Right (want, B.drop 1 rest) + +consumeAll :: Consume () +consumeAll _ _ = Left () + +resumeOnEOF :: [B.ByteString] -> Get L.ByteString +resumeOnEOF = return . L.fromChunks + -- | Get a lazy ByteString that is terminated with a NUL byte. -- The returned string does not contain the NUL byte. Fails -- if it reaches the end of input without finding a NUL. getLazyByteStringNul :: Get L.ByteString -getLazyByteStringNul = L.fromChunks <$> go - where - findNull str = - case B.break (==0) str of - (want,rest) | B.null rest -> Nothing - | otherwise -> Just (want, B.drop 1 rest) - go = do - str <- get - case findNull str of - Nothing -> do - put B.empty - demandInput - fmap (str:) go - Just (want,rest) -> do - put rest - return [want] +getLazyByteStringNul = withInputChunks () consumeUntilNul L.fromChunks failOnEOF -- | Get the remaining bytes as a lazy ByteString. -- Note that this can be an expensive function to use as it forces reading -- all input and keeping the string in-memory. getRemainingLazyByteString :: Get L.ByteString -getRemainingLazyByteString = L.fromChunks <$> go - where - go = do - str <- get - put B.empty - done <- isEmpty - if done - then return [str] - else fmap (str:) go +getRemainingLazyByteString = withInputChunks () consumeAll L.fromChunks resumeOnEOF ------------------------------------------------------------------------ -- Primtives 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 @@ -16,13 +16,16 @@ , readNWith -- * Parsing - , skip , bytesRead , isolate + + -- * With input chunks + , withInputChunks + , Consume + , failOnEOF , get , put - , demandInput , ensureN -- * Utility @@ -168,15 +171,18 @@ Done _ _ -> r prompt :: B.ByteString -> Decoder a -> (B.ByteString -> Decoder a) -> Decoder a -prompt inp kf ks = - let loop = - Partial $ \sm -> - case sm of - Just s | B.null s -> loop - | otherwise -> ks (inp `B.append` s) - Nothing -> kf - in loop +prompt inp kf ks = prompt' kf (\inp' -> ks (inp `B.append` inp')) +prompt' :: Decoder a -> (B.ByteString -> Decoder a) -> Decoder a +prompt' kf ks = + let loop = + Partial $ \sm -> + case sm of + Just s | B.null s -> loop + | otherwise -> ks s + Nothing -> kf + in loop + -- | Get the total number of bytes read to this point. bytesRead :: Get Int64 bytesRead = C $ \inp k -> BytesRead (fromIntegral $ B.length inp) (k inp) @@ -216,16 +222,24 @@ go n (BytesRead r resume) = go n (resume $! fromIntegral n0 - fromIntegral n - r) --- | Demand more input. If none available, fail. -demandInput :: Get () -demandInput = C $ \inp ks -> - prompt inp (Fail inp "demandInput: not enough bytes") (\inp' -> ks inp' ()) +type Consume s = s -> B.ByteString -> Either s (B.ByteString, B.ByteString) --- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available. -skip :: Int -> Get () -skip n = readN n (const ()) -{-# INLINE skip #-} +withInputChunks :: s -> Consume s -> ([B.ByteString] -> b) -> ([B.ByteString] -> Get b) -> Get b +withInputChunks initS consume onSucc onFail = go initS [] + where + go state acc = C $ \inp ks -> + case consume state inp of + Left state' -> do + let acc' = inp : acc + prompt' + (runCont (onFail (reverse acc')) B.empty ks) + (\str' -> runCont (go state' acc') str' ks) + Right (want,rest) -> do + ks rest (onSucc (reverse (want:acc))) +failOnEOF :: [B.ByteString] -> Get a +failOnEOF bs = C $ \_ _ -> Fail (B.concat bs) "not enough bytes" + -- | Test whether all input has been consumed, i.e. there are no remaining -- undecoded bytes. isEmpty :: Get Bool @@ -384,13 +398,14 @@ ensureN !n0 = C $ \inp ks -> do if B.length inp >= n0 then ks inp () - else runCont (go n0) inp ks + else runCont (withInputChunks n0 enoughChunks onSucc onFail >>= put) inp ks where -- might look a bit funny, but plays very well with GHC's inliner. -- GHC won't inline recursive functions, so we make ensureN non-recursive - go n = C $ \inp ks -> do - if B.length inp >= n - then ks inp () - else runCont (demandInput >> go n) inp ks + enoughChunks n str + | B.length str >= n = Right (str,B.empty) + | otherwise = Left (n - B.length str) + onSucc = B.concat + onFail bss = C $ \_ _ -> Fail (B.concat bss) "not enough bytes" {-# INLINE ensureN #-} unsafeReadN :: Int -> (B.ByteString -> a) -> Get a diff --git a/tests/Action.hs b/tests/Action.hs --- a/tests/Action.hs +++ b/tests/Action.hs @@ -23,6 +23,8 @@ data Action = Actions [Action] | GetByteString Int + | GetByteStringL Int + | Skip Int | Isolate Int [Action] | Try [Action] [Action] | Label String [Action] @@ -43,6 +45,8 @@ BytesRead -> [] Fail -> [] GetByteString n -> [ GetByteString n' | n' <- shrink n ] + GetByteStringL n -> [ GetByteStringL n' | n' <- shrink n ] + Skip n -> [ Skip n' | n' <- shrink n ] Isolate n as -> nub $ Actions as : [ Isolate n' as' | (n',as') <- shrink (n,as) , n' >= 0 @@ -76,6 +80,8 @@ BytesRead -> max_len xs Fail -> 0 GetByteString n -> n + max_len xs + GetByteStringL n -> n + max_len xs + Skip n -> n + max_len xs Isolate n xs' | Just _ <- actual_len' [Isolate n xs'] -> n + max_len xs | otherwise -> n @@ -212,7 +218,7 @@ step :: Int -> Int -> [String] -> [Action] -> Eval step inp n lbls xs | inp - n < 0 = - let msg = "demandInput: not enough bytes" + let msg = "not enough bytes" in EFail FRTooMuch (msg:lbls) inp | otherwise = go (inp-n) lbls xs go :: Int -> [String] -> [Action] -> Eval @@ -223,6 +229,8 @@ BytesRead -> go inp lbls xs Fail -> EFail FRFail ("fail":lbls) inp GetByteString n -> step inp n lbls xs + GetByteStringL n -> step inp n lbls xs + Skip n -> step inp n lbls xs Isolate n xs' | n > inp -> case go inp lbls xs' of @@ -281,6 +289,18 @@ "execute(getByteString): actual /= expected at pos " ++ show pos ++ ", got: " ++ show actual ++ ", expected: " ++ show expected go (pos+n) xs + GetByteStringL n -> do + -- Run the operation in the Get monad... + actual <- L.toStrict <$> Binary.getLazyByteString (fromIntegral n) + let expected = B.take n . B.drop pos $ inp + -- ... and compare that we got what we expected. + when (actual /= expected) $ error $ + "execute(getLazyByteString): actual /= expected at pos " ++ show pos ++ + ", got: " ++ show actual ++ ", expected: " ++ show expected + go (pos+n) xs + Skip n -> do + Binary.skip n + go (pos+n) xs BytesRead -> do pos' <- Binary.bytesRead if pos == fromIntegral pos' @@ -332,6 +352,10 @@ go _ 0 = return [] go inTry s = oneof $ [ do n <- choose (0,10) (:) (GetByteString n) <$> go inTry (s-1) + , do n <- choose (0,10) + (:) (GetByteStringL n) <$> go inTry (s-1) + , do n <- choose (0,10) + (:) (Skip n) <$> go inTry (s-1) , do (:) BytesRead <$> go inTry (s-1) , do t1 <- go True (s `div` 2) t2 <- go inTry (s `div` 2) diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#if MIN_VERSION_base(4,8,0) -#define HAS_NATURAL -#endif - module Arbitrary where import Test.QuickCheck @@ -12,10 +8,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -#ifdef HAS_NATURAL -import Numeric.Natural -#endif - instance Arbitrary L.ByteString where arbitrary = fmap L.fromChunks arbitrary @@ -61,17 +53,3 @@ (a,b,c,d,e) <- arbitrary (f,g,h,i,j) <- arbitrary return (a,b,c,d,e,f,g,h,i,j) - - -#ifdef HAS_NATURAL --- | Generates a natural number. The number must be positive --- and its maximum value depends on the size parameter. -arbitrarySizedNatural :: Gen Natural -arbitrarySizedNatural = - sized $ \n0 -> - let n = toInteger n0 in - inBounds fromInteger (choose (0, n*n)) - -inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a -inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x)) -#endif diff --git a/tests/Makefile b/tests/Makefile deleted file mode 100644 --- a/tests/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -ghc := ghc -ghc-flags := - -all: compiled - -interpreted: - runhaskell QC.hs 1000 - -compiled: - $(ghc) --make -fhpc -O QC.hs -o qc -fforce-recomp -threaded -rtsopts -i../src -XCPP -package test-framework -package test-framework-quickcheck2 $(ghc-flags) - rm -f qc.tix - ./qc --maximum-generated-tests=1000 -j2 +RTS -N2 - -hugs: - runhugs -98 QC.hs - -clean: - rm -f *.o *.hi qc *.tix *~ - -.PHONY: clean diff --git a/tests/QC.hs b/tests/QC.hs --- a/tests/QC.hs +++ b/tests/QC.hs @@ -16,16 +16,16 @@ import Data.Ratio import System.IO.Unsafe +#ifdef HAS_NATURAL +import Numeric.Natural +#endif + import Test.Framework import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck import qualified Action (tests) -import Arbitrary ( -#ifdef HAS_NATURAL - arbitrarySizedNatural -#endif - ) +import Arbitrary () import Data.Binary import Data.Binary.Get import Data.Binary.Put @@ -358,10 +358,20 @@ ------------------------------------------------------------------------ #ifdef HAS_NATURAL --- | Until the QuickCheck library implements instance Arbitrary Natural, --- we need this test. prop_test_Natural :: Property -prop_test_Natural = forAll arbitrarySizedNatural test +prop_test_Natural = forAll (gen :: Gen Natural) test + where + gen :: Gen Natural + gen = do + b <- arbitrary + if b + then do + x <- arbitrarySizedNatural :: Gen Natural + -- arbitrarySizedNatural generates numbers smaller than + -- (maxBound :: Word64), so let's make them bigger to better test + -- the Binary instance. + return (x + fromIntegral (maxBound :: Word64)) + else arbitrarySizedNatural #endif ------------------------------------------------------------------------