Move to bytestring Builder

benchmarks/Builder.hs

@@ -21,12 +21,6 @@ import Data.Word (Word8)
 
 import Data.Binary.Builder
 
-#if !MIN_VERSION_bytestring(0,10,0)
-instance NFData S.ByteString
-instance NFData L.ByteString where
-  rnf = rnf . L.toChunks
-#endif
-
 main :: IO ()
 main = do
   evaluate $ rnf

binary.cabal

@@ -31,17 +31,15 @@ source-repository head
   location: git://github.com/kolmodin/binary.git
 
 library
-  build-depends:   base >= 3.0 && < 5, bytestring >= 0.9, containers, array
+  build-depends:   base >= 3.0 && < 5, bytestring >= 0.10.2, containers, array
   hs-source-dirs:  src
   exposed-modules: Data.Binary,
                    Data.Binary.Put,
                    Data.Binary.Get,
                    Data.Binary.Get.Internal,
-                   Data.Binary.Builder,
-                   Data.Binary.Builder.Internal
+                   Data.Binary.Builder
 
-  other-modules:   Data.Binary.Builder.Base,
-                   Data.Binary.Class,
+  other-modules:   Data.Binary.Class,
                    Data.Binary.Internal
 
   if impl(ghc >= 7.2.1)
@@ -70,7 +68,7 @@ test-suite qc
     Arbitrary
   build-depends:
     base >= 3.0 && < 5,
-    bytestring >= 0.9,
+    bytestring >= 0.10.2,
     random>=1.0.1.0,
     test-framework,
     test-framework-quickcheck2 >= 0.3,
@@ -86,7 +84,7 @@ test-suite read-write-file
   main-is: File.hs
   build-depends:
     base >= 3.0 && < 5,
-    bytestring >= 0.9,
+    bytestring >= 0.10.2,
     Cabal,
     directory,
     filepath,

src/Data/Binary/Builder.hs

@@ -1,23 +1,28 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, MagicHash #-}
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Safe #-}
 #endif
+
 -----------------------------------------------------------------------------
 -- |
--- Module      : Data.Binary.Builder
+-- Module      : Data.Binary.Builder.Base
 -- Copyright   : Lennart Kolmodin, Ross Paterson
 -- License     : BSD3-style (see LICENSE)
 --
 -- Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>
 -- Stability   : experimental
 -- Portability : portable to Hugs and GHC
 --
--- Efficient construction of lazy bytestrings.
+-- A module exporting types and functions that are shared by
+-- 'Data.Binary.Builder' and 'Data.Binary.Builder.Internal'.
 --
 -----------------------------------------------------------------------------
 
-module Data.Binary.Builder (
+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
+#include "MachDeps.h"
+#endif
 
+module Data.Binary.Builder (
     -- * The Builder type
       Builder
     , toLazyByteString
@@ -31,7 +36,6 @@ module Data.Binary.Builder (
 #if MIN_VERSION_bytestring(0,10,4)
     , fromShortByteString   -- :: T.ByteString -> Builder
 #endif
-
     -- * Flushing the buffer state
     , flush
 
@@ -65,6 +69,222 @@ module Data.Binary.Builder (
       -- ** Unicode
     , putCharUtf8
 
-  ) where
+      -- * Low-level construction of Builders
+    --, writeN
+    --, writeAtMost
+    ) where
+
+import qualified Data.ByteString      as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Short as T
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Builder.Prim as Prim
+import Data.ByteString.Builder ( Builder, toLazyByteString )
+import Data.ByteString.Builder.Extra ( flush )
+import Data.Monoid
+import Data.Word
+import Foreign
+import Prelude -- Silence AMP warning.
+
+------------------------------------------------------------------------
+
+-- | /O(1)./ The empty Builder, satisfying
+--
+--  * @'toLazyByteString' 'empty' = 'L.empty'@
+--
+empty :: Builder
+empty = mempty
+{-# INLINE empty #-}
+
+-- | /O(1)./ A Builder taking a single byte, satisfying
+--
+--  * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@
+--
+singleton :: Word8 -> Builder
+singleton = B.word8
+{-# INLINE singleton #-}
+
+------------------------------------------------------------------------
+
+-- | /O(1)./ The concatenation of two Builders, an associative operation
+-- with identity 'empty', satisfying
+--
+--  * @'toLazyByteString' ('append' x y) = 'L.append' ('toLazyByteString' x) ('toLazyByteString' y)@
+--
+append :: Builder -> Builder -> Builder
+append = mappend
+{-# INLINE append #-}
+
+-- | /O(1)./ A Builder taking a 'S.ByteString', satisfying
+--
+--  * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@
+--
+fromByteString :: S.ByteString -> Builder
+fromByteString = B.byteString
+{-# INLINE fromByteString #-}
+
+-- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying
+--
+--  * @'toLazyByteString' ('fromLazyByteString' bs) = bs@
+--
+fromLazyByteString :: L.ByteString -> Builder
+fromLazyByteString = B.lazyByteString
+{-# INLINE fromLazyByteString #-}
+
+#if MIN_VERSION_bytestring(0,10,4)
+-- | /O(n)./ A builder taking 'T.ShortByteString' and copy it to a Builder,
+-- satisfying
+--
+-- * @'toLazyByteString' ('fromShortByteString' bs) = 'L.fromChunks' ['T.fromShort' bs]
+fromShortByteString :: T.ShortByteString -> Builder
+fromShortByteString = B.shortByteString
+{-# INLINE fromShortByteString #-}
+#endif
+
+------------------------------------------------------------------------
+
+--
+-- We rely on the fromIntegral to do the right masking for us.
+-- The inlining here is critical, and can be worth 4x performance
+--
+
+-- | Write a Word16 in big endian format
+putWord16be :: Word16 -> Builder
+putWord16be = B.word16BE
+{-# INLINE putWord16be #-}
+
+-- | Write a Word16 in little endian format
+putWord16le :: Word16 -> Builder
+putWord16le = B.word16LE
+{-# INLINE putWord16le #-}
+
+-- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)
+
+-- | Write a Word32 in big endian format
+putWord32be :: Word32 -> Builder
+putWord32be = B.word32BE
+{-# INLINE putWord32be #-}
+
+--
+-- a data type to tag Put/Check. writes construct these which are then
+-- inlined and flattened. matching Checks will be more robust with rules.
+--
+
+-- | Write a Word32 in little endian format
+putWord32le :: Word32 -> Builder
+putWord32le = B.word32LE
+{-# INLINE putWord32le #-}
+
+-- | Write a Word64 in big endian format
+putWord64be :: Word64 -> Builder
+putWord64be = B.word64BE
+{-# INLINE putWord64be #-}
+
+-- | Write a Word64 in little endian format
+putWord64le :: Word64 -> Builder
+putWord64le = B.word64LE
+{-# INLINE putWord64le #-}
+
+-- on a little endian machine:
+-- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)
+
+
+-- | Write a Int16 in big endian format
+putInt16be :: Int16 -> Builder
+putInt16be = putWord16be . fromIntegral
+{-# INLINE putInt16be #-}
+
+-- | Write a Int16 in little endian format
+putInt16le :: Int16 -> Builder
+putInt16le = putWord16le . fromIntegral
+{-# INLINE putInt16le #-}
+
+-- | Write a Int32 in big endian format
+putInt32be :: Int32 -> Builder
+putInt32be = putWord32be . fromIntegral
+{-# INLINE putInt32be #-}
+
+-- | Write a Int32 in little endian format
+putInt32le :: Int32 -> Builder
+putInt32le = putWord32le . fromIntegral
+{-# INLINE putInt32le #-}
+
+-- | Write a Int64 in big endian format
+putInt64be :: Int64 -> Builder
+putInt64be = putWord64be . fromIntegral
+
+-- | Write a Int64 in little endian format
+putInt64le :: Int64 -> Builder
+putInt64le = putWord64le . fromIntegral
+
+
+
+------------------------------------------------------------------------
+-- Unaligned, word size ops
+
+-- | /O(1)./ A Builder taking a single native machine word. The word is
+-- written in host order, host endian form, for the machine you're on.
+-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,
+-- 4 bytes. Values written this way are not portable to
+-- different endian or word sized machines, without conversion.
+--
+putWordhost :: Word -> Builder
+putWordhost = Prim.primFixed Prim.wordHost
+{-# INLINE putWordhost #-}
+
+-- | Write a Word16 in native host order and host endianness.
+-- 2 bytes will be written, unaligned.
+putWord16host :: Word16 -> Builder
+putWord16host = Prim.primFixed Prim.word16Host
+{-# INLINE putWord16host #-}
+
+-- | Write a Word32 in native host order and host endianness.
+-- 4 bytes will be written, unaligned.
+putWord32host :: Word32 -> Builder
+putWord32host = Prim.primFixed Prim.word32Host
+{-# INLINE putWord32host #-}
+
+-- | Write a Word64 in native host order.
+-- On a 32 bit machine we write two host order Word32s, in big endian form.
+-- 8 bytes will be written, unaligned.
+putWord64host :: Word64 -> Builder
+putWord64host = Prim.primFixed Prim.word64Host
+{-# INLINE putWord64host #-}
+
+-- | /O(1)./ A Builder taking a single native machine word. The word is
+-- written in host order, host endian form, for the machine you're on.
+-- On a 64 bit machine the Int is an 8 byte value, on a 32 bit machine,
+-- 4 bytes. Values written this way are not portable to
+-- different endian or word sized machines, without conversion.
+--
+putInthost :: Int -> Builder
+putInthost = Prim.primFixed Prim.intHost
+{-# INLINE putInthost #-}
+
+-- | Write a Int16 in native host order and host endianness.
+-- 2 bytes will be written, unaligned.
+putInt16host :: Int16 -> Builder
+putInt16host = Prim.primFixed Prim.int16Host
+{-# INLINE putInt16host #-}
+
+-- | Write a Int32 in native host order and host endianness.
+-- 4 bytes will be written, unaligned.
+putInt32host :: Int32 -> Builder
+putInt32host = Prim.primFixed Prim.int32Host
+{-# INLINE putInt32host #-}
+
+-- | Write a Int64 in native host order.
+-- On a 32 bit machine we write two host order Int32s, in big endian form.
+-- 8 bytes will be written, unaligned.
+putInt64host :: Int64 -> Builder
+putInt64host = Prim.primFixed Prim.int64Host
+{-# INLINE putInt64host #-}
+
+
+------------------------------------------------------------------------
+-- Unicode
 
-import Data.Binary.Builder.Base
+-- | Write a character using UTF-8 encoding.
+putCharUtf8 :: Char -> Builder
+putCharUtf8 = Prim.primBounded Prim.charUtf8
+{-# INLINE putCharUtf8 #-}