diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.4.2 +version: 0.4.3 license: BSD3 license-file: LICENSE author: Lennart Kolmodin @@ -30,7 +30,7 @@ cpp-options: -DBYTESTRING_IN_BASE else -- in base 1.0 and 3.0 bytestring is a separate package - build-depends: base < 2.0 || >= 3, bytestring >= 0.9 + build-depends: base < 2.0 || >= 3, bytestring >= 0.9.1.0 if flag(split-base) build-depends: base >= 3.0, containers, array @@ -42,13 +42,21 @@ cpp-options: -DAPPLICATIVE_IN_BASE else build-depends: base < 2.0 + hs-source-dirs: src exposed-modules: Data.Binary, Data.Binary.Put, Data.Binary.Get, Data.Binary.Builder - extensions: CPP, FlexibleContexts - hs-source-dirs: src - ghc-options: -O2 -Wall -fliberate-case-threshold=1000 - if impl(ghc < 6.5) - cpp-options: -fallow-undecidable-instances + extensions: CPP, + FlexibleContexts + + ghc-options: -O2 + -Wall + -fspec-constr + -fliberate-case-threshold=1000 + -fdicts-cheap + -fno-method-sharing + +-- if impl(ghc < 6.5) +-- ghc-options: -fallow-undecidable-instances diff --git a/docs/hcar/binary-Lb.tex b/docs/hcar/binary-Lb.tex new file mode 100644 --- /dev/null +++ b/docs/hcar/binary-Lb.tex @@ -0,0 +1,48 @@ +\begin{hcarentry}{binary} +\label{binary} +\report{Lennart Kolmodin} +\status{active} +\participants{Duncan Coutts, Don Stewart, Binary Strike Team} +\makeheader + +The Binary Strike Team is pleased to announce yet a release of a new, +pure, efficient binary serialisation library. + +The `binary' package provides efficient serialisation of Haskell values +to and from lazy ByteStrings. ByteStrings constructed this way may then +be written to disk, written to the network, or further processed (e.g. +stored in memory directly, or compressed in memory with zlib or bzlib). + +The binary library has been heavily tuned for performance, particularly for +writing speed. Throughput of up to 160M/s has been achieved in practice, and +in general speed is on par or better than NewBinary, with the advantage of a +pure interface. Efforts are underway to improve performance still further. +Plans are also taking shape for a parser combinator library on top of +binary, for bit parsing and foreign structure parsing (e.g. network +protocols). + +Data.Derive~\cref{derive} has support for automatically generating Binary +instances, allowing to read and write your data structures with little fuzz. + +Binary was developed by a team of 8 during the Haskell Hackathon in Oxford +2007, and since then has about 15 people contributed code and many more +given feedback and cheerleading on \verb|#haskell|. + +The package is cabalized and available through Hackage~\cref{hackagedb}. +% to editors: ref. to cabal? + +\FurtherReading +\begin{compactitem} +\item Homepage + + \url{http://code.haskell.org/binary/} +\item Hackage + + \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary} +\item Development version + + \texttt{darcs get --partial} + + \url{http://code.haskell.org/binary} +\end{compactitem} +\end{hcarentry} diff --git a/index.html b/index.html --- a/index.html +++ b/index.html @@ -25,6 +25,18 @@ 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 parse 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: @@ -142,7 +154,7 @@ diff --git a/src/Data/Binary.hs b/src/Data/Binary.hs --- a/src/Data/Binary.hs +++ b/src/Data/Binary.hs @@ -251,7 +251,7 @@ encodeFile :: Binary a => FilePath -> a -> IO () encodeFile f v = L.writeFile f (encode v) --- | Lazily reconstruct a value previously written to a file +-- | Lazily reconstruct a value previously written to a file. -- -- This is just a convenience function, it's defined simply as: -- @@ -261,8 +261,20 @@ -- -- > return . decode . decompress =<< B.readFile f -- +-- After contructing the data from the input file, 'decodeFile' checks +-- if the file is empty, and in doing so will force the associated file +-- handle closed, if it is indeed empty. If the file is not empty, +-- it is up to the decoding instance to consume the rest of the data, +-- or otherwise finalise the resource. +-- decodeFile :: Binary a => FilePath -> IO a -decodeFile f = liftM decode (L.readFile f) +decodeFile f = do + s <- L.readFile f + return $ runGet (do v <- get + m <- isEmpty + m `seq` return v) s + +-- needs bytestring 0.9.1.x to work ------------------------------------------------------------------------ -- Lazy put and get diff --git a/src/Data/Binary/Builder.hs b/src/Data/Binary/Builder.hs --- a/src/Data/Binary/Builder.hs +++ b/src/Data/Binary/Builder.hs @@ -99,7 +99,9 @@ instance Monoid Builder where mempty = empty + {-# INLINE mempty #-} mappend = append + {-# INLINE mappend #-} ------------------------------------------------------------------------ @@ -109,6 +111,7 @@ -- empty :: Builder empty = Builder id +{-# INLINE empty #-} -- | /O(1)./ A Builder taking a single byte, satisfying -- @@ -127,6 +130,7 @@ -- append :: Builder -> Builder -> Builder append (Builder f) (Builder g) = Builder (f . g) +{-# INLINE append #-} -- | /O(1)./ A Builder taking a 'S.ByteString', satisfying -- @@ -136,6 +140,7 @@ fromByteString bs | S.null bs = empty | otherwise = flush `append` mapBuilder (bs :) +{-# INLINE fromByteString #-} -- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying -- @@ -143,6 +148,7 @@ -- fromLazyByteString :: L.ByteString -> Builder fromLazyByteString bss = flush `append` mapBuilder (L.toChunks bss ++) +{-# INLINE fromLazyByteString #-} ------------------------------------------------------------------------ @@ -212,7 +218,7 @@ -- bytes into the memory. writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder writeN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f) -{-# INLINE [1] writeN #-} +{-# INLINE writeN #-} writeNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer writeNBuffer n f (Buffer fp o u l) = do @@ -224,6 +230,7 @@ newBuffer size = do fp <- S.mallocByteString size return $! Buffer fp 0 0 size +{-# INLINE newBuffer #-} ------------------------------------------------------------------------ -- Aligned, host order writes of storable values @@ -232,7 +239,7 @@ -- storable values into the memory. writeNbytes :: Storable a => Int -> (Ptr a -> IO ()) -> Builder writeNbytes n f = ensureFree n `append` unsafeLiftIO (writeNBufferBytes n f) -{-# INLINE [1] writeNbytes #-} +{-# INLINE writeNbytes #-} writeNBufferBytes :: Storable a => Int -> (Ptr a -> IO ()) -> Buffer -> IO Buffer writeNBufferBytes n f (Buffer fp o u l) = do @@ -388,8 +395,11 @@ ------------------------------------------------------------------------ -- Unchecked shifts +{-# INLINE shiftr_w16 #-} shiftr_w16 :: Word16 -> Int -> Word16 +{-# INLINE shiftr_w32 #-} shiftr_w32 :: Word32 -> Int -> Word32 +{-# INLINE shiftr_w64 #-} shiftr_w64 :: Word64 -> Int -> Word64 #if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) 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 @@ -110,6 +110,7 @@ instance Functor Get where fmap f m = Get (\s -> let (a, s') = unGet m s in (f a, s')) + {-# INLINE fmap #-} #ifdef APPLICATIVE_IN_BASE instance Applicative Get where @@ -119,8 +120,12 @@ instance Monad Get where return a = Get (\s -> (a, s)) + {-# INLINE return #-} + m >>= k = Get (\s -> let (a, s') = unGet m s in unGet (k a) s') + {-# INLINE (>>=) #-} + fail = failDesc instance MonadFix Get where diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -45,6 +45,7 @@ ) where +import Data.Monoid import Data.Binary.Builder (Builder, toLazyByteString) import qualified Data.Binary.Builder as B @@ -59,49 +60,64 @@ ------------------------------------------------------------------------ +-- XXX Strict in buffer only. +data PairS a = PairS a {-# UNPACK #-}!Builder + +sndS :: PairS a -> Builder +sndS (PairS _ b) = b + -- | The PutM type. A Writer monad over the efficient Builder monoid. -newtype PutM a = Put { unPut :: (a, Builder) } +newtype PutM a = Put { unPut :: PairS a } --- | Put merely lifts Builder into a Write monad, applied to (). +-- | Put merely lifts Builder into a Writer monad, applied to (). type Put = PutM () instance Functor PutM where - fmap f m = Put (let (a, w) = unPut m - in (f a, w)) + fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w + {-# INLINE fmap #-} #ifdef APPLICATIVE_IN_BASE instance Applicative PutM where - pure = return - m <*> k = Put (let (f, w) = unPut m - (x, w') = unPut k - in (f x, w `B.append` w')) + pure = return + m <*> k = Put $ + let PairS f w = unPut m + PairS x w' = unPut k + in PairS (f x) (w `mappend` w') #endif +-- Standard Writer monad, with aggressive inlining instance Monad PutM where - return a = Put (a, B.empty) + return a = Put $ PairS a mempty + {-# INLINE return #-} - m >>= k = Put (let (a, w) = unPut m - (b, w') = unPut (k a) - in (b, w `B.append` w')) + m >>= k = Put $ + let PairS a w = unPut m + PairS b w' = unPut (k a) + in PairS b (w `mappend` w') + {-# INLINE (>>=) #-} - m1 >> m2 = Put (let (_, w) = unPut m1 - (b, w') = unPut m2 - in (b, w `B.append` w')) - {-# INlINE (>>) #-} + m >> k = Put $ + let PairS _ w = unPut m + PairS b w' = unPut k + in PairS b (w `mappend` w') + {-# INLINE (>>) #-} tell :: Builder -> Put -tell b = Put ((), b) -{-# INlINE tell #-} +tell b = Put $ PairS () b +{-# INLINE tell #-} -- | Run the 'Put' monad with a serialiser -runPut :: Put -> L.ByteString -runPut = toLazyByteString . snd . unPut +runPut :: Put -> L.ByteString +runPut = toLazyByteString . sndS . unPut {-# INLINE runPut #-} +------------------------------------------------------------------------ + -- | Pop the ByteString we have constructed so far, if any, yielding a -- new chunk in the result ByteString. flush :: Put flush = tell B.flush +{-# INLINE flush #-} -- | Efficiently write a byte into the output buffer putWord8 :: Word8 -> Put @@ -112,19 +128,23 @@ -- It flushes the current buffer, and writes the argument into a new chunk. putByteString :: S.ByteString -> Put putByteString = tell . B.fromByteString +{-# INLINE putByteString #-} -- | Write a lazy ByteString efficiently, simply appending the lazy -- ByteString chunks to the output buffer putLazyByteString :: L.ByteString -> Put putLazyByteString = tell . B.fromLazyByteString +{-# INLINE putLazyByteString #-} -- | Write a Word16 in big endian format putWord16be :: Word16 -> Put putWord16be = tell . B.putWord16be +{-# INLINE putWord16be #-} -- | Write a Word16 in little endian format putWord16le :: Word16 -> Put putWord16le = tell . B.putWord16le +{-# INLINE putWord16le #-} -- | Write a Word32 in big endian format putWord32be :: Word32 -> Put