diff --git a/benchmarks/Builder.hs b/benchmarks/Builder.hs
--- a/benchmarks/Builder.hs
+++ b/benchmarks/Builder.hs
@@ -21,12 +21,6 @@
 
 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
diff --git a/benchmarks/Get.hs b/benchmarks/Get.hs
--- a/benchmarks/Get.hs
+++ b/benchmarks/Get.hs
@@ -370,12 +370,12 @@
 encodedBigInteger :: L.ByteString
 encodedBigInteger = encode bigInteger
 
-roll_foldr :: (Integral a, Num a, Bits a) => [Word8] -> a
+roll_foldr :: (Integral a, Bits a) => [Word8] -> a
 roll_foldr   = foldr unstep 0
   where
     unstep b a = a `shiftL` 8 .|. fromIntegral b
 
-roll_foldl' :: (Integral a, Num a, Bits a) => [Word8] -> a
+roll_foldl' :: (Integral a, Bits a) => [Word8] -> a
 roll_foldl'   = foldl' unstep 0 . reverse
   where
     unstep a b = a `shiftL` 8 .|. fromIntegral b
diff --git a/benchmarks/Put.hs b/benchmarks/Put.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Put.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE CPP, ExistentialQuantification #-}
+#ifdef GENERICS
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+
+module Main (main) where
+
+import Control.DeepSeq
+import Control.Exception (evaluate)
+import Criterion.Main
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as L
+import Data.Monoid
+
+#ifdef GENERICS
+import GHC.Generics
+#endif
+
+import Data.Binary
+import Data.Binary.Put
+import Data.ByteString.Builder as BB
+import Prelude -- Silence Monoid import warning.
+
+main :: IO ()
+main = do
+  evaluate $ rnf
+    [ rnf bigIntegers
+    , rnf smallIntegers
+    , rnf smallByteStrings
+    , rnf smallStrings
+    , rnf doubles
+    , rnf word8s
+    , rnf word16s
+    , rnf word32s
+    , rnf word64s
+    ]
+  defaultMain
+    [
+      bench "small Integers" $ whnf (run . fromIntegers) smallIntegers,
+      bench "big Integers" $ whnf (run . fromIntegers) bigIntegers,
+
+      bench "[small Integer]" $ whnf (run . put) smallIntegers,
+      bench "[big Integer]" $ whnf (run . put) bigIntegers,
+
+      bench "small ByteStrings" $ whnf (run . fromByteStrings) smallByteStrings,
+      bench "[small ByteString]" $ whnf (run . put) smallByteStrings,
+
+      bench "small Strings" $ whnf (run . fromStrings) smallStrings,
+      bench "[small String]" $ whnf (run . put) smallStrings,
+
+      bench "Double" $ whnf (run . put) doubles,
+
+      bench "Word8s monoid put" $ whnf (run . fromWord8s) word8s,
+      bench "Word8s builder" $ whnf (L.length . toLazyByteString . fromWord8sBuilder) word8s,
+      bench "[Word8]" $ whnf (run . put) word8s,
+      bench "Word16s monoid put" $ whnf (run . fromWord16s) word16s,
+      bench "Word16s builder" $ whnf (L.length . toLazyByteString . fromWord16sBuilder) word16s,
+      bench "[Word16]" $ whnf (run . put) word16s,
+      bench "Word32s monoid put" $ whnf (run . fromWord32s) word32s,
+      bench "Word32s builder" $ whnf (L.length . toLazyByteString . fromWord32sBuilder) word32s,
+      bench "[Word32]" $ whnf (run . put) word32s,
+      bench "Word64s monoid put" $ whnf (run . fromWord64s) word64s,
+      bench "Word64s builder" $ whnf (L.length . toLazyByteString . fromWord64sBuilder) word64s,
+      bench "[Word64]" $ whnf (run . put) word64s
+
+#ifdef GENERICS
+      , bgroup "Generics" [
+        bench "Struct monoid put" $ whnf (run . fromStructs) structs,
+        bench "Struct put as list" $ whnf (run . put) structs,
+        bench "StructList monoid put" $ whnf (run . fromStructLists) structLists,
+        bench "StructList put as list" $ whnf (run . put) structLists
+      ]
+#endif
+    ]
+  where
+    run = L.length . runPut
+
+#ifdef GENERICS
+data Struct = Struct Word8 Word16 Word32 Word64 deriving Generic
+instance Binary Struct
+
+data StructList = StructList [Struct] deriving Generic
+instance Binary StructList
+
+structs :: [Struct]
+structs = take 10000 $ [ Struct a b 0 0 | a <- [0 .. maxBound], b <- [0 .. maxBound] ]
+
+structLists :: [StructList]
+structLists = replicate 1000 (StructList (take 10 structs))
+#endif
+
+-- Input data
+
+smallIntegers :: [Integer]
+smallIntegers = [0..10000]
+{-# NOINLINE smallIntegers #-}
+
+bigIntegers :: [Integer]
+bigIntegers = [m .. m + 10000]
+  where
+    m :: Integer
+    m = fromIntegral (maxBound :: Word64)
+{-# NOINLINE bigIntegers #-}
+
+smallByteStrings :: [S.ByteString]
+smallByteStrings = replicate 10000 $ C.pack "abcdefghi"
+{-# NOINLINE smallByteStrings #-}
+
+smallStrings :: [String]
+smallStrings = replicate 10000 "abcdefghi"
+{-# NOINLINE smallStrings #-}
+
+doubles :: [Double]
+doubles = take 10000 $ [ sign * 2 ** n | sign <- [-1, 1], n <- [ 0, 0.2 .. 1023 ]]
+
+word8s :: [Word8]
+word8s = take 10000 $ cycle [minBound .. maxBound]
+{-# NOINLINE word8s #-}
+
+word16s :: [Word16]
+word16s = take 10000 $ cycle [minBound .. maxBound]
+{-# NOINLINE word16s #-}
+
+word32s :: [Word32]
+word32s = take 10000 $ cycle [minBound .. maxBound]
+{-# NOINLINE word32s #-}
+
+word64s :: [Word64]
+word64s = take 10000 $ cycle [minBound .. maxBound]
+{-# NOINLINE word64s #-}
+
+------------------------------------------------------------------------
+-- Benchmarks
+
+fromIntegers :: [Integer] -> Put
+fromIntegers [] = mempty
+fromIntegers (x:xs) = put x `mappend` fromIntegers xs
+
+fromByteStrings :: [S.ByteString] -> Put
+fromByteStrings [] = mempty
+fromByteStrings (x:xs) = put x `mappend` fromByteStrings xs
+
+fromStrings :: [String] -> Put
+fromStrings [] = mempty
+fromStrings (x:xs) = put x `mappend` fromStrings xs
+
+fromWord8s :: [Word8] -> Put
+fromWord8s [] = mempty
+fromWord8s (x:xs) = put x `mappend` fromWord8s xs
+
+fromWord8sBuilder :: [Word8] -> BB.Builder
+fromWord8sBuilder [] = mempty
+fromWord8sBuilder (x:xs) = BB.word8 x `mappend` fromWord8sBuilder xs
+
+fromWord16s :: [Word16] -> Put
+fromWord16s [] = mempty
+fromWord16s (x:xs) = put x `mappend` fromWord16s xs
+
+fromWord16sBuilder :: [Word16] -> BB.Builder
+fromWord16sBuilder [] = mempty
+fromWord16sBuilder (x:xs) = BB.word16BE x `mappend` fromWord16sBuilder xs
+
+fromWord32s :: [Word32] -> Put
+fromWord32s [] = mempty
+fromWord32s (x:xs) = put x `mappend` fromWord32s xs
+
+fromWord32sBuilder :: [Word32] -> BB.Builder
+fromWord32sBuilder [] = mempty
+fromWord32sBuilder (x:xs) = BB.word32BE x `mappend` fromWord32sBuilder xs
+
+fromWord64s :: [Word64] -> Put
+fromWord64s [] = mempty
+fromWord64s (x:xs) = put x `mappend` fromWord64s xs
+
+fromWord64sBuilder :: [Word64] -> BB.Builder
+fromWord64sBuilder [] = mempty
+fromWord64sBuilder (x:xs) = BB.word64BE x `mappend` fromWord64sBuilder xs
+
+#ifdef GENERICS
+fromStructs :: [Struct] -> Put
+fromStructs [] = mempty
+fromStructs (x:xs) = put x `mappend` fromStructs xs
+
+fromStructLists :: [StructList] -> Put
+fromStructLists [] = mempty
+fromStructLists (x:xs) = put x `mappend` fromStructLists xs
+#endif
diff --git a/binary.cabal b/binary.cabal
--- a/binary.cabal
+++ b/binary.cabal
@@ -1,5 +1,5 @@
 name:            binary
-version:         0.8.2.1
+version:         0.8.3.0
 license:         BSD3
 license-file:    LICENSE
 author:          Lennart Kolmodin <kolmodin@gmail.com>
@@ -18,7 +18,7 @@
 stability:       provisional
 build-type:      Simple
 cabal-version:   >= 1.8
-tested-with:     GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2
+tested-with:     GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3
 extra-source-files:
   README.md changelog.md docs/hcar/binary-Lb.tex tools/derive/*.hs
 
@@ -31,17 +31,15 @@
   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 @@
     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 @@
   main-is: File.hs
   build-depends:
     base >= 3.0 && < 5,
-    bytestring >= 0.9,
+    bytestring >= 0.10.2,
     Cabal,
     directory,
     filepath,
@@ -125,6 +123,25 @@
   -- build dependencies from using binary source rather than depending on the library
   build-depends: array, containers
   ghc-options: -O2 -Wall
+
+benchmark put
+  type: exitcode-stdio-1.0
+  hs-source-dirs: src benchmarks
+  main-is: Put.hs
+  build-depends:
+    base >= 3.0 && < 5,
+    bytestring,
+    criterion == 1.*,
+    deepseq
+  -- build dependencies from using binary source rather than depending on the library
+  build-depends: array, containers
+  ghc-options: -O2 -Wall
+  if impl(ghc >= 7.2.1)
+    cpp-options: -DGENERICS
+    other-modules: Data.Binary.Generic
+    if impl(ghc <= 7.6)
+      -- prior to ghc-7.4 generics lived in ghc-prim
+      build-depends: ghc-prim
 
 benchmark generics-bench
   type: exitcode-stdio-1.0
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,6 +1,20 @@
 binary
 ======
 
+binary-0.8.3.0
+--------------
+
+- Replace binary's home grown `Builder` with `Data.ByteString.Builder`.
+  `Data.Binary.Builder` now exports `Data.ByteString.Builder.Builder`.
+- Add `putList :: [a] -> Put` to the `Binary` class. This is used to be able to
+  use the list writing primitives of the new Builder. This brought a number of speedups;
+  Encoding a String is now 70% faster. [Word8] is 76% faster, which also makes
+  Integer 34% faster. Similar numbers for all [IntXX] and [WordXX].
+- Fail gracefully within `Get` when decoding `Bool` and `Ordering`. Previously
+  when decoding invalid data these instances would fail with `error`.
+- Add Binary instance for `Complex a`.
+- Add Monoid and Semigroup instance for `Put`.
+
 binary-0.8.2.1
 --------------
 
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
@@ -1,7 +1,8 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, MagicHash #-}
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Safe #-}
 #endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Builder
@@ -12,12 +13,13 @@
 -- Stability   : experimental
 -- Portability : portable to Hugs and GHC
 --
--- Efficient construction of lazy bytestrings.
+-- Efficient constructions of lazy bytestrings.
 --
+-- This now re-exports 'Data.ByteString.Lazy.Builder'.
+--
 -----------------------------------------------------------------------------
 
 module Data.Binary.Builder (
-
     -- * The Builder type
       Builder
     , toLazyByteString
@@ -31,7 +33,6 @@
 #if MIN_VERSION_bytestring(0,10,4)
     , fromShortByteString   -- :: T.ByteString -> Builder
 #endif
-
     -- * Flushing the buffer state
     , flush
 
@@ -64,7 +65,208 @@
 
       -- ** Unicode
     , putCharUtf8
+    , putStringUtf8
+    ) where
 
-  ) 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 Data.Int
+import Prelude -- Silence AMP warning.
 
-import Data.Binary.Builder.Base
+------------------------------------------------------------------------
+
+-- | /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
+
+------------------------------------------------------------------------
+
+-- | 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 #-}
+
+-- | Write a Word32 in big endian format
+putWord32be :: Word32 -> Builder
+putWord32be = B.word32BE
+{-# INLINE putWord32be #-}
+
+-- | 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 #-}
+
+-- | Write a Int16 in big endian format
+putInt16be :: Int16 -> Builder
+putInt16be = B.int16BE
+{-# INLINE putInt16be #-}
+
+-- | Write a Int16 in little endian format
+putInt16le :: Int16 -> Builder
+putInt16le = B.int16LE
+{-# INLINE putInt16le #-}
+
+-- | Write a Int32 in big endian format
+putInt32be :: Int32 -> Builder
+putInt32be = B.int32BE
+{-# INLINE putInt32be #-}
+
+-- | Write a Int32 in little endian format
+putInt32le :: Int32 -> Builder
+putInt32le = B.int32LE
+{-# INLINE putInt32le #-}
+
+-- | Write a Int64 in big endian format
+putInt64be :: Int64 -> Builder
+putInt64be = B.int64BE
+
+-- | Write a Int64 in little endian format
+putInt64le :: Int64 -> Builder
+putInt64le = B.int64LE
+
+
+------------------------------------------------------------------------
+-- 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
+
+-- | Write a character using UTF-8 encoding.
+putCharUtf8 :: Char -> Builder
+putCharUtf8 = Prim.primBounded Prim.charUtf8
+{-# INLINE putCharUtf8 #-}
+
+-- | Write a String using UTF-8 encoding.
+putStringUtf8 :: String -> Builder
+putStringUtf8 = Prim.primMapListBounded Prim.charUtf8
+{-# INLINE putStringUtf8 #-}
diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs
deleted file mode 100644
--- a/src/Data/Binary/Builder/Base.hs
+++ /dev/null
@@ -1,621 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Trustworthy #-}
-#endif
-
------------------------------------------------------------------------------
--- |
--- 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
---
--- A module exporting types and functions that are shared by
--- 'Data.Binary.Builder' and 'Data.Binary.Builder.Internal'.
---
------------------------------------------------------------------------------
-
-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-#include "MachDeps.h"
-#endif
-
-module Data.Binary.Builder.Base (
-    -- * The Builder type
-      Builder
-    , toLazyByteString
-
-    -- * Constructing Builders
-    , empty
-    , singleton
-    , append
-    , fromByteString        -- :: S.ByteString -> Builder
-    , fromLazyByteString    -- :: L.ByteString -> Builder
-#if MIN_VERSION_bytestring(0,10,4)
-    , fromShortByteString   -- :: T.ByteString -> Builder
-#endif
-    -- * Flushing the buffer state
-    , flush
-
-    -- * Derived Builders
-    -- ** Big-endian writes
-    , putWord16be           -- :: Word16 -> Builder
-    , putWord32be           -- :: Word32 -> Builder
-    , putWord64be           -- :: Word64 -> Builder
-    , putInt16be            -- :: Int16 -> Builder
-    , putInt32be            -- :: Int32 -> Builder
-    , putInt64be            -- :: Int64 -> Builder
-
-    -- ** Little-endian writes
-    , putWord16le           -- :: Word16 -> Builder
-    , putWord32le           -- :: Word32 -> Builder
-    , putWord64le           -- :: Word64 -> Builder
-    , putInt16le            -- :: Int16 -> Builder
-    , putInt32le            -- :: Int32 -> Builder
-    , putInt64le            -- :: Int64 -> Builder
-
-    -- ** Host-endian, unaligned writes
-    , putWordhost           -- :: Word -> Builder
-    , putWord16host         -- :: Word16 -> Builder
-    , putWord32host         -- :: Word32 -> Builder
-    , putWord64host         -- :: Word64 -> Builder
-    , putInthost            -- :: Int -> Builder
-    , putInt16host          -- :: Int16 -> Builder
-    , putInt32host          -- :: Int32 -> Builder
-    , putInt64host          -- :: Int64 -> Builder
-
-      -- ** Unicode
-    , putCharUtf8
-
-      -- * Low-level construction of Builders
-    , writeN
-    , writeAtMost
-    ) where
-
-import qualified Data.ByteString      as S
-import qualified Data.ByteString.Lazy as L
-#if MIN_VERSION_bytestring(0,10,4)
-import qualified Data.ByteString.Short as T
-import qualified Data.ByteString.Short.Internal as T
-#endif
-#if MIN_VERSION_base(4,9,0)
-import Data.Semigroup
-#else
-import Data.Monoid
-#endif
-import Data.Word
-import Foreign
-
-import System.IO.Unsafe as IO ( unsafePerformIO )
-
-import Data.Binary.Internal ( accursedUnutterablePerformIO )
-import qualified Data.ByteString.Internal as S
-import qualified Data.ByteString.Lazy.Internal as L
-
-#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-import GHC.Base (ord,Int(..),uncheckedShiftRL#)
-import GHC.Word (Word32(..),Word16(..),Word64(..))
-# if WORD_SIZE_IN_BITS < 64
-import GHC.Word (uncheckedShiftRL64#)
-# endif
-#endif
-import Prelude -- Silence AMP warning.
-
-------------------------------------------------------------------------
-
--- | A 'Builder' is an efficient way to build lazy 'L.ByteString's.
--- There are several functions for constructing 'Builder's, but only one
--- to inspect them: to extract any data, you have to turn them into lazy
--- 'L.ByteString's using 'toLazyByteString'.
---
--- Internally, a 'Builder' constructs a lazy 'L.Bytestring' by filling byte
--- arrays piece by piece.  As each buffer is filled, it is \'popped\'
--- off, to become a new chunk of the resulting lazy 'L.ByteString'.
--- All this is hidden from the user of the 'Builder'.
-
-newtype Builder = Builder {
-        runBuilder :: (Buffer -> IO L.ByteString)
-                   -> Buffer
-                   -> IO L.ByteString
-    }
-
-#if MIN_VERSION_base(4,9,0)
-instance Semigroup Builder where
-    (<>) = append
-    {-# INLINE (<>) #-}
-#endif
-
-instance Monoid Builder where
-    mempty  = empty
-    {-# INLINE mempty #-}
-#if MIN_VERSION_base(4,9,0)
-    mappend = (<>)
-#else
-    mappend = append
-#endif
-    {-# INLINE mappend #-}
-    mconcat = foldr mappend mempty
-    {-# INLINE mconcat #-}
-
-------------------------------------------------------------------------
-
--- | /O(1)./ The empty Builder, satisfying
---
---  * @'toLazyByteString' 'empty' = 'L.empty'@
---
-empty :: Builder
-empty = Builder (\ k b -> k b)
-{-# INLINE empty #-}
-
--- | /O(1)./ A Builder taking a single byte, satisfying
---
---  * @'toLazyByteString' ('singleton' b) = 'L.singleton' b@
---
-singleton :: Word8 -> Builder
-singleton = writeN 1 . flip poke
-{-# 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 (Builder f) (Builder g) = Builder (f . g)
-{-# INLINE [0] append #-}
-
--- | /O(1)./ A Builder taking a 'S.ByteString', satisfying
---
---  * @'toLazyByteString' ('fromByteString' bs) = 'L.fromChunks' [bs]@
---
-fromByteString :: S.ByteString -> Builder
-fromByteString bs
-  | S.null bs = empty
-  | otherwise = flush `append` mapBuilder (L.Chunk bs)
-{-# INLINE fromByteString #-}
-
--- | /O(1)./ A Builder taking a lazy 'L.ByteString', satisfying
---
---  * @'toLazyByteString' ('fromLazyByteString' bs) = bs@
---
-fromLazyByteString :: L.ByteString -> Builder
-fromLazyByteString bss = flush `append` mapBuilder (bss `L.append`)
-{-# 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 sbs = writeN (T.length sbs) $ \ptr ->
-   T.copyToPtr sbs 0 ptr (T.length sbs)
-{-# INLINE fromShortByteString #-}
-#endif
-
-------------------------------------------------------------------------
-
--- Our internal buffer type
-data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
-                     {-# UNPACK #-} !Int                -- offset
-                     {-# UNPACK #-} !Int                -- used bytes
-                     {-# UNPACK #-} !Int                -- length left
-
-------------------------------------------------------------------------
-
--- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.
--- The construction work takes place if and when the relevant part of
--- the lazy 'L.ByteString' is demanded.
---
-toLazyByteString :: Builder -> L.ByteString
-toLazyByteString m = IO.unsafePerformIO $ do
-    buf <- newBuffer defaultSize
-    runBuilder (m `append` flush) (const (return L.Empty)) buf
-{-# INLINE toLazyByteString #-}
-
--- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,
--- yielding a new chunk in the result lazy 'L.ByteString'.
-flush :: Builder
-flush = Builder $ \ k buf@(Buffer p o u l) ->
-    if u == 0  -- Invariant (from Data.ByteString.Lazy)
-      then k buf
-      else let !b  = Buffer p (o+u) 0 l
-               !bs = S.PS p o u
-           -- It should be safe to use accursedUnutterablePerformIO here.
-           -- The place in the buffer where we write is determined by the 'b'
-           -- value, and writes should be deterministic. The thunk should not
-           -- be floated out and shared since the buffer references the
-           -- incoming foreign ptr.
-           in return $! L.Chunk bs (accursedUnutterablePerformIO (k b))
-{-# INLINE [0] flush #-}
-
-------------------------------------------------------------------------
-
---
--- copied from Data.ByteString.Lazy
---
-defaultSize :: Int
-defaultSize = 32 * k - overhead
-    where k = 1024
-          overhead = 2 * sizeOf (undefined :: Int)
-
-------------------------------------------------------------------------
-
--- | Sequence an IO operation on the buffer
-withBuffer :: (Buffer -> IO Buffer) -> Builder
-withBuffer f = Builder $ \ k buf -> f buf >>= k
-{-# INLINE withBuffer #-}
-
--- | Get the size of the buffer
-withSize :: (Int -> Builder) -> Builder
-withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->
-    runBuilder (f l) k buf
-
--- | Map the resulting list of bytestrings.
-mapBuilder :: (L.ByteString -> L.ByteString) -> Builder
-mapBuilder f = Builder (fmap f .)
-
-------------------------------------------------------------------------
-
--- | Ensure that there are at least @n@ many bytes available.
-ensureFree :: Int -> Builder
-ensureFree n = n `seq` withSize $ \ l ->
-    if n <= l then empty else
-        flush `append` withBuffer (const (newBuffer (max n defaultSize)))
-{-# INLINE [0] ensureFree #-}
-
--- | Ensure that @n@ bytes are available, and then use @f@ to write at
--- most @n@ bytes into memory.  @f@ must return the actual number of
--- bytes written.
-writeAtMost :: Int -> (Ptr Word8 -> IO Int) -> Builder
-writeAtMost n f = ensureFree n `append` withBuffer (writeBuffer f)
-{-# INLINE [0] writeAtMost #-}
-
--- | Ensure that @n@ bytes are available, and then use @f@ to write
--- exactly @n@ bytes into memory.
-writeN :: Int -> (Ptr Word8 -> IO ()) -> Builder
-writeN n f = writeAtMost n (\ p -> f p >> return n)
-{-# INLINE writeN #-}
-
-writeBuffer :: (Ptr Word8 -> IO Int) -> Buffer -> IO Buffer
-writeBuffer f (Buffer fp o u l) = do
-    n <- withForeignPtr fp (\p -> f (p `plusPtr` (o+u)))
-    return $! Buffer fp o (u+n) (l-n)
-{-# INLINE writeBuffer #-}
-
-newBuffer :: Int -> IO Buffer
-newBuffer size = do
-    fp <- S.mallocByteString size
-    return $! Buffer fp 0 0 size
-{-# INLINE newBuffer #-}
-
-------------------------------------------------------------------------
-
---
--- 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 w = writeN 2 $ \p -> do
-    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)
-{-# INLINE putWord16be #-}
-
--- | Write a Word16 in little endian format
-putWord16le :: Word16 -> Builder
-putWord16le w = writeN 2 $ \p -> do
-    poke p               (fromIntegral (w)              :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)
-{-# INLINE putWord16le #-}
-
--- putWord16le w16 = writeN 2 (\p -> poke (castPtr p) w16)
-
--- | Write a Word32 in big endian format
-putWord32be :: Word32 -> Builder
-putWord32be w = writeN 4 $ \p -> do
-    poke p               (fromIntegral (shiftr_w32 w 24) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w  8) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (w)               :: Word8)
-{-# 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 w = writeN 4 $ \p -> do
-    poke p               (fromIntegral (w)               :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w  8) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)
-{-# INLINE putWord32le #-}
-
--- on a little endian machine:
--- putWord32le w32 = writeN 4 (\p -> poke (castPtr p) w32)
-
--- | Write a Word64 in big endian format
-putWord64be :: Word64 -> Builder
-#if WORD_SIZE_IN_BITS < 64
---
--- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
--- Word32, and write that
---
-putWord64be w =
-    let a = fromIntegral (shiftr_w64 w 32) :: Word32
-        b = fromIntegral w                 :: Word32
-    in writeN 8 $ \p -> do
-    poke p               (fromIntegral (shiftr_w32 a 24) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a  8) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (a)               :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b  8) :: Word8)
-    poke (p `plusPtr` 7) (fromIntegral (b)               :: Word8)
-#else
-putWord64be w = writeN 8 $ \p -> do
-    poke p               (fromIntegral (shiftr_w64 w 56) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w  8) :: Word8)
-    poke (p `plusPtr` 7) (fromIntegral (w)               :: Word8)
-#endif
-{-# INLINE putWord64be #-}
-
--- | Write a Word64 in little endian format
-putWord64le :: Word64 -> Builder
-
-#if WORD_SIZE_IN_BITS < 64
-putWord64le w =
-    let b = fromIntegral (shiftr_w64 w 32) :: Word32
-        a = fromIntegral w                 :: Word32
-    in writeN 8 $ \p -> do
-    poke (p)             (fromIntegral (a)               :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a  8) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (b)               :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b  8) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)
-    poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)
-#else
-putWord64le w = writeN 8 $ \p -> do
-    poke p               (fromIntegral (w)               :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w  8) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)
-    poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)
-#endif
-{-# 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 w =
-    writeN (sizeOf (undefined :: Word)) (\p -> poke (castPtr p) w)
-{-# INLINE putWordhost #-}
-
--- | Write a Word16 in native host order and host endianness.
--- 2 bytes will be written, unaligned.
-putWord16host :: Word16 -> Builder
-putWord16host w16 =
-    writeN (sizeOf (undefined :: Word16)) (\p -> poke (castPtr p) w16)
-{-# INLINE putWord16host #-}
-
--- | Write a Word32 in native host order and host endianness.
--- 4 bytes will be written, unaligned.
-putWord32host :: Word32 -> Builder
-putWord32host w32 =
-    writeN (sizeOf (undefined :: Word32)) (\p -> poke (castPtr p) w32)
-{-# 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 w =
-    writeN (sizeOf (undefined :: Word64)) (\p -> poke (castPtr p) w)
-{-# 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 w =
-    writeN (sizeOf (undefined :: Int)) (\p -> poke (castPtr p) w)
-{-# INLINE putInthost #-}
-
--- | Write a Int16 in native host order and host endianness.
--- 2 bytes will be written, unaligned.
-putInt16host :: Int16 -> Builder
-putInt16host w16 =
-    writeN (sizeOf (undefined :: Int16)) (\p -> poke (castPtr p) w16)
-{-# INLINE putInt16host #-}
-
--- | Write a Int32 in native host order and host endianness.
--- 4 bytes will be written, unaligned.
-putInt32host :: Int32 -> Builder
-putInt32host w32 =
-    writeN (sizeOf (undefined :: Int32)) (\p -> poke (castPtr p) w32)
-{-# 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 w =
-    writeN (sizeOf (undefined :: Int64)) (\p -> poke (castPtr p) w)
-{-# INLINE putInt64host #-}
-
-
-------------------------------------------------------------------------
--- Unicode
-
--- Code lifted from the text package by Bryan O'Sullivan.
-
--- | Write a character using UTF-8 encoding.
-putCharUtf8 :: Char -> Builder
-putCharUtf8 x = writeAtMost 4 $ \ p -> case undefined of
-    _ | n <= 0x7F   -> poke p c >> return 1
-      | n <= 0x07FF -> do
-          poke p a2
-          poke (p `plusPtr` 1) b2
-          return 2
-      | n <= 0xFFFF -> do
-          poke p a3
-          poke (p `plusPtr` 1) b3
-          poke (p `plusPtr` 2) c3
-          return 3
-      | otherwise   -> do
-          poke p a4
-          poke (p `plusPtr` 1) b4
-          poke (p `plusPtr` 2) c4
-          poke (p `plusPtr` 3) d4
-          return 4
-  where
-      n = ord x
-      c = fromIntegral n
-      (a2,b2) = ord2 x
-      (a3,b3,c3) = ord3 x
-      (a4,b4,c4,d4) = ord4 x
-
-ord2 :: Char -> (Word8,Word8)
-ord2 c = (x1,x2)
-  where
-    n = ord c
-    x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
-    x2 = fromIntegral $ (n .&. 0x3F) + 0x80
-
-ord3 :: Char -> (Word8,Word8,Word8)
-ord3 c = (x1,x2,x3)
-  where
-    n = ord c
-    x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
-    x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
-    x3 = fromIntegral $ (n .&. 0x3F) + 0x80
-
-ord4 :: Char -> (Word8,Word8,Word8,Word8)
-ord4 c = (x1,x2,x3,x4)
-  where
-    n = ord c
-    x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
-    x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
-    x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
-    x4 = fromIntegral $ (n .&. 0x3F) + 0x80
-
-------------------------------------------------------------------------
--- 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__)
-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)
-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)
-
-# if WORD_SIZE_IN_BITS < 64
-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
-# else
-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)
-# endif
-
-#else
-shiftr_w16 = shiftR
-shiftr_w32 = shiftR
-shiftr_w64 = shiftR
-#endif
-
-------------------------------------------------------------------------
--- Some nice rules for Builder
-
-#if __GLASGOW_HASKELL__ >= 700
--- In versions of GHC prior to 7.0 these rules would make GHC believe
--- that 'writeN' and 'ensureFree' are recursive and the rules wouldn't
--- fire.
-{-# RULES
-
-"append/writeAtMost" forall a b (f::Ptr Word8 -> IO Int)
-                                (g::Ptr Word8 -> IO Int) ws.
-    append (writeAtMost a f) (append (writeAtMost b g) ws) =
-        append (writeAtMost (a+b) (\p -> f p >>= \n ->
-                                    g (p `plusPtr` n) >>= \m ->
-                                    let s = n+m in s `seq` return s)) ws
-
-"writeAtMost/writeAtMost" forall a b (f::Ptr Word8 -> IO Int)
-                                     (g::Ptr Word8 -> IO Int).
-    append (writeAtMost a f) (writeAtMost b g) =
-        writeAtMost (a+b) (\p -> f p >>= \n ->
-                            g (p `plusPtr` n) >>= \m ->
-                            let s = n+m in s `seq` return s)
-
-"ensureFree/ensureFree" forall a b .
-    append (ensureFree a) (ensureFree b) = ensureFree (max a b)
-
-"flush/flush"
-    append flush flush = flush #-}
-#endif
diff --git a/src/Data/Binary/Builder/Internal.hs b/src/Data/Binary/Builder/Internal.hs
deleted file mode 100644
--- a/src/Data/Binary/Builder/Internal.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Safe #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      : Data.Binary.Builder.Internal
--- Copyright   : Lennart Kolmodin, Ross Paterson
--- License     : BSD3-style (see LICENSE)
---
--- Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>
--- Stability   : experimental
--- Portability : portable to Hugs and GHC
---
--- A module containing semi-public 'Builder' internals that exposes
--- low level construction functions.  Modules which extend the
--- 'Builder' system will need to use this module while ideally most
--- users will be able to make do with the public interface modules.
---
------------------------------------------------------------------------------
-
-module Data.Binary.Builder.Internal (
-    -- * Low-level construction of Builders
-      writeN
-    , writeAtMost
-    ) where
-
-import Data.Binary.Builder.Base
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
@@ -53,6 +53,7 @@
 import Data.Word
 import Data.Bits
 import Data.Int
+import Data.Complex (Complex(..))
 #ifdef HAS_VOID
 import Data.Void
 #endif
@@ -62,13 +63,15 @@
 
 #if ! MIN_VERSION_base(4,8,0)
 import Control.Applicative
+import Data.Monoid (mempty)
 #endif
+import Data.Monoid ((<>))
 import Control.Monad
 
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Builder.Prim as Prim
 
-import Data.Char    (ord)
 import Data.List    (unfoldr, foldl')
 
 -- And needed for the instances:
@@ -147,6 +150,12 @@
     -- | Decode a value in the Get monad
     get :: Get t
 
+    -- | Encode a list of values in the Put monad.
+    -- The default implementation may be overridden to be more efficient
+    -- but must still have the same encoding format.
+    putList :: [t] -> Put
+    putList = defaultPutList
+
 #ifdef GENERICS
     default put :: (Generic t, GBinaryPut (Rep t)) => t -> Put
     put = gput . from
@@ -155,6 +164,10 @@
     get = to `fmap` gget
 #endif
 
+{-# INLINE defaultPutList #-}
+defaultPutList :: Binary a => [a] -> Put
+defaultPutList xs = put (length xs) <> mapM_ put xs
+
 ------------------------------------------------------------------------
 -- Simple instances
 
@@ -171,18 +184,27 @@
 -- The () type need never be written to disk: values of singleton type
 -- can be reconstructed from the type alone
 instance Binary () where
-    put ()  = return ()
+    put ()  = mempty
     get     = return ()
 
 -- Bools are encoded as a byte in the range 0 .. 1
 instance Binary Bool where
     put     = putWord8 . fromIntegral . fromEnum
-    get     = liftM (toEnum . fromIntegral) getWord8
+    get     = getWord8 >>= toBool
+      where
+        toBool 0 = return False
+        toBool 1 = return True
+        toBool c = fail ("Could not map value " ++ show c ++ " to Bool")
 
 -- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
 instance Binary Ordering where
     put     = putWord8 . fromIntegral . fromEnum
-    get     = liftM (toEnum . fromIntegral) getWord8
+    get     = getWord8 >>= toOrd
+      where
+        toOrd 0 = return LT
+        toOrd 1 = return EQ
+        toOrd 2 = return GT
+        toOrd c = fail ("Could not map value " ++ show c ++ " to Ordering")
 
 ------------------------------------------------------------------------
 -- Words and Ints
@@ -190,41 +212,73 @@
 -- Words8s are written as bytes
 instance Binary Word8 where
     put     = putWord8
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.word8 xs)
     get     = getWord8
 
 -- Words16s are written as 2 bytes in big-endian (network) order
 instance Binary Word16 where
     put     = putWord16be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.word16BE xs)
     get     = getWord16be
 
 -- Words32s are written as 4 bytes in big-endian (network) order
 instance Binary Word32 where
     put     = putWord32be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.word32BE xs)
     get     = getWord32be
 
 -- Words64s are written as 8 bytes in big-endian (network) order
 instance Binary Word64 where
     put     = putWord64be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.word64BE xs)
     get     = getWord64be
 
 -- Int8s are written as a single byte.
 instance Binary Int8 where
     put     = putInt8
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.int8 xs)
     get     = getInt8
 
 -- Int16s are written as a 2 bytes in big endian format
 instance Binary Int16 where
     put     = putInt16be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.int16BE xs)
     get     = getInt16be
 
 -- Int32s are written as a 4 bytes in big endian format
 instance Binary Int32 where
     put     = putInt32be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.int32BE xs)
     get     = getInt32be
 
 -- Int64s are written as a 8 bytes in big endian format
 instance Binary Int64 where
     put     = putInt64be
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.int64BE xs)
     get     = getInt64be
 
 ------------------------------------------------------------------------
@@ -232,11 +286,19 @@
 -- Words are are written as Word64s, that is, 8 bytes in big endian format
 instance Binary Word where
     put     = putWord64be . fromIntegral
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.word64BE (map fromIntegral xs))
     get     = liftM fromIntegral getWord64be
 
 -- Ints are are written as Int64s, that is, 8 bytes in big endian format
 instance Binary Int where
     put     = putInt64be . fromIntegral
+    {-# INLINE putList #-}
+    putList xs =
+        put (length xs)
+        <> putBuilder (Prim.primMapListFixed Prim.int64BE (map fromIntegral xs))
     get     = liftM fromIntegral getInt64be
 
 ------------------------------------------------------------------------
@@ -255,17 +317,16 @@
 instance Binary Integer where
 
     {-# INLINE put #-}
-    put n | n >= lo && n <= hi = do
-        putWord8 0
-        put (fromIntegral n :: SmallInt)  -- fast path
+    put n | n >= lo && n <= hi =
+        putBuilder (Prim.primFixed (Prim.word8 Prim.>*< Prim.int32BE) (0, fromIntegral n))
      where
         lo = fromIntegral (minBound :: SmallInt) :: Integer
         hi = fromIntegral (maxBound :: SmallInt) :: Integer
 
-    put n = do
+    put n =
         putWord8 1
-        put sign
-        put (unroll (abs n))         -- unroll the bytes
+        <> put sign
+        <> put (unroll (abs n))         -- unroll the bytes
      where
         sign = fromIntegral (signum n) :: Word8
 
@@ -312,15 +373,15 @@
 -- | /Since: 0.7.3.0/
 instance Binary Natural where
     {-# INLINE put #-}
-    put n | n <= hi = do
+    put n | n <= hi =
         putWord8 0
-        put (fromIntegral n :: NaturalWord)  -- fast path
+        <> put (fromIntegral n :: NaturalWord)  -- fast path
      where
         hi = fromIntegral (maxBound :: NaturalWord) :: Natural
 
-    put n = do
+    put n =
         putWord8 1
-        put (unroll (abs n))         -- unroll the bytes
+        <> put (unroll (abs n))         -- unroll the bytes
 
     {-# INLINE get #-}
     get = do
@@ -398,32 +459,21 @@
 -}
 
 instance (Binary a,Integral a) => Binary (R.Ratio a) where
-    put r = put (R.numerator r) >> put (R.denominator r)
+    put r = put (R.numerator r) <> put (R.denominator r)
     get = liftM2 (R.%) get get
 
+instance Binary a => Binary (Complex a) where
+    {-# INLINE put #-}
+    put (r :+ i) = put (r, i)
+    {-# INLINE get #-}
+    get = (\(r,i) -> r :+ i) <$> get
+
 ------------------------------------------------------------------------
 
 -- Char is serialised as UTF-8
 instance Binary Char where
-    put a | c <= 0x7f     = put (fromIntegral c :: Word8)
-          | c <= 0x7ff    = do put (0xc0 .|. y)
-                               put (0x80 .|. z)
-          | c <= 0xffff   = do put (0xe0 .|. x)
-                               put (0x80 .|. y)
-                               put (0x80 .|. z)
-          | c <= 0x10ffff = do put (0xf0 .|. w)
-                               put (0x80 .|. x)
-                               put (0x80 .|. y)
-                               put (0x80 .|. z)
-          | otherwise     = error "Not a valid Unicode code point"
-     where
-        c = ord a
-        z, y, x, w :: Word8
-        z = fromIntegral (c           .&. 0x3f)
-        y = fromIntegral (shiftR c 6  .&. 0x3f)
-        x = fromIntegral (shiftR c 12 .&. 0x3f)
-        w = fromIntegral (shiftR c 18 .&. 0x7)
-
+    put = putCharUtf8
+    putList str = put (length str) <> putStringUtf8 str
     get = do
         let getByte = liftM (fromIntegral :: Word8 -> Int) get
             shiftL6 = flip shiftL 6 :: Int -> Int
@@ -454,19 +504,19 @@
 -- Instances for the first few tuples
 
 instance (Binary a, Binary b) => Binary (a,b) where
-    put (a,b)           = put a >> put b
+    put (a,b)           = put a <> put b
     get                 = liftM2 (,) get get
 
 instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
-    put (a,b,c)         = put a >> put b >> put c
+    put (a,b,c)         = put a <> put b <> put c
     get                 = liftM3 (,,) get get get
 
 instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
-    put (a,b,c,d)       = put a >> put b >> put c >> put d
+    put (a,b,c,d)       = put a <> put b <> put c <> put d
     get                 = liftM4 (,,,) get get get get
 
 instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where
-    put (a,b,c,d,e)     = put a >> put b >> put c >> put d >> put e
+    put (a,b,c,d,e)     = put a <> put b <> put c <> put d <> put e
     get                 = liftM5 (,,,,) get get get get get
 
 --
@@ -505,9 +555,9 @@
 -- Container types
 
 instance Binary a => Binary [a] where
-    put l  = put (length l) >> mapM_ put l
-    get    = do n <- get :: Get Int
-                getMany n
+    put = putList
+    get = do n <- get :: Get Int
+             getMany n
 
 -- | 'getMany n' get 'n' elements in order, without blowing the stack.
 getMany :: Binary a => Int -> Get [a]
@@ -522,7 +572,7 @@
 
 instance (Binary a) => Binary (Maybe a) where
     put Nothing  = putWord8 0
-    put (Just x) = putWord8 1 >> put x
+    put (Just x) = putWord8 1 <> put x
     get = do
         w <- getWord8
         case w of
@@ -530,8 +580,8 @@
             _ -> liftM Just get
 
 instance (Binary a, Binary b) => Binary (Either a b) where
-    put (Left  a) = putWord8 0 >> put a
-    put (Right b) = putWord8 1 >> put b
+    put (Left  a) = putWord8 0 <> put a
+    put (Right b) = putWord8 1 <> put b
     get = do
         w <- getWord8
         case w of
@@ -542,8 +592,8 @@
 -- ByteStrings (have specially efficient instances)
 
 instance Binary B.ByteString where
-    put bs = do put (B.length bs)
-                putByteString bs
+    put bs = put (B.length bs)
+             <> putByteString bs
     get    = get >>= getByteString
 
 --
@@ -552,15 +602,15 @@
 -- Requires 'flexible instances'
 --
 instance Binary ByteString where
-    put bs = do put (fromIntegral (L.length bs) :: Int)
-                putLazyByteString bs
+    put bs = put (fromIntegral (L.length bs) :: Int)
+             <> putLazyByteString bs
     get    = get >>= getLazyByteString
 
 
 #if MIN_VERSION_bytestring(0,10,4)
 instance Binary BS.ShortByteString where
-   put bs = do put (BS.length bs)
-               putShortByteString bs
+   put bs = put (BS.length bs)
+            <> putShortByteString bs
    get = get >>= fmap BS.toShort . getByteString
 #endif
 
@@ -568,19 +618,19 @@
 -- Maps and Sets
 
 instance (Binary a) => Binary (Set.Set a) where
-    put s = put (Set.size s) >> mapM_ put (Set.toAscList s)
+    put s = put (Set.size s) <> mapM_ put (Set.toAscList s)
     get   = liftM Set.fromDistinctAscList get
 
 instance (Binary k, Binary e) => Binary (Map.Map k e) where
-    put m = put (Map.size m) >> mapM_ put (Map.toAscList m)
+    put m = put (Map.size m) <> mapM_ put (Map.toAscList m)
     get   = liftM Map.fromDistinctAscList get
 
 instance Binary IntSet.IntSet where
-    put s = put (IntSet.size s) >> mapM_ put (IntSet.toAscList s)
+    put s = put (IntSet.size s) <> mapM_ put (IntSet.toAscList s)
     get   = liftM IntSet.fromDistinctAscList get
 
 instance (Binary e) => Binary (IntMap.IntMap e) where
-    put m = put (IntMap.size m) >> mapM_ put (IntMap.toAscList m)
+    put m = put (IntMap.size m) <> mapM_ put (IntMap.toAscList m)
     get   = liftM IntMap.fromDistinctAscList get
 
 ------------------------------------------------------------------------
@@ -592,7 +642,7 @@
 --
 
 instance (Binary e) => Binary (Seq.Seq e) where
-    put s = put (Seq.length s) >> Fold.mapM_ put s
+    put s = put (Seq.length s) <> Fold.mapM_ put s
     get = do n <- get :: Get Int
              rep Seq.empty n get
       where rep xs 0 _ = return $! xs
@@ -623,17 +673,17 @@
 -- Trees
 
 instance (Binary e) => Binary (T.Tree e) where
-    put (T.Node r s) = put r >> put s
+    put (T.Node r s) = put r <> put s
     get = liftM2 T.Node get get
 
 ------------------------------------------------------------------------
 -- Arrays
 
 instance (Binary i, Ix i, Binary e) => Binary (Array i e) where
-    put a = do
+    put a =
         put (bounds a)
-        put (rangeSize $ bounds a) -- write the length
-        mapM_ put (elems a)        -- now the elems.
+        <> put (rangeSize $ bounds a) -- write the length
+        <> mapM_ put (elems a)        -- now the elems.
     get = do
         bs <- get
         n  <- get                  -- read the length
@@ -644,10 +694,10 @@
 -- The IArray UArray e constraint is non portable. Requires flexible instances
 --
 instance (Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) where
-    put a = do
+    put a =
         put (bounds a)
-        put (rangeSize $ bounds a) -- now write the length
-        mapM_ put (elems a)
+        <> put (rangeSize $ bounds a) -- now write the length
+        <> mapM_ put (elems a)
     get = do
         bs <- get
         n  <- get
@@ -660,9 +710,7 @@
 #ifdef HAS_GHC_FINGERPRINT
 -- | /Since: 0.7.6.0/
 instance Binary Fingerprint where
-    put (Fingerprint x1 x2) = do
-        put x1
-        put x2
+    put (Fingerprint x1 x2) = put x1 <> put x2
     get = do
         x1 <- get
         x2 <- get
@@ -674,5 +722,5 @@
 
 -- | /Since: 0.8.0.0/
 instance Binary Version where
+    put (Version br tags) = put br <> put tags
     get = Version <$> get <*> get
-    put (Version br tags) = put br >> put tags
diff --git a/src/Data/Binary/Generic.hs b/src/Data/Binary/Generic.hs
--- a/src/Data/Binary/Generic.hs
+++ b/src/Data/Binary/Generic.hs
@@ -28,26 +28,27 @@
 import Data.Binary.Put
 import Data.Bits
 import Data.Word
+import Data.Monoid ((<>))
 import GHC.Generics
 import Prelude -- Silence AMP warning.
 
 -- Type without constructors
 instance GBinaryPut V1 where
-    gput _ = return ()
+    gput _ = pure ()
 
 instance GBinaryGet V1 where
     gget   = return undefined
 
 -- Constructor without arguments
 instance GBinaryPut U1 where
-    gput U1 = return ()
+    gput U1 = pure ()
 
 instance GBinaryGet U1 where
     gget    = return U1
 
 -- Product: constructor with parameters
 instance (GBinaryPut a, GBinaryPut b) => GBinaryPut (a :*: b) where
-    gput (x :*: y) = gput x >> gput y
+    gput (x :*: y) = gput x <> gput y
 
 instance (GBinaryGet a, GBinaryGet b) => GBinaryGet (a :*: b) where
     gget = (:*:) <$> gget <*> gget
@@ -130,7 +131,7 @@
     getSum _ _ = gget
 
 instance GBinaryPut a => GSumPut (C1 c a) where
-    putSum !code _ x = put code *> gput x
+    putSum !code _ x = put code <> gput x
 
 ------------------------------------------------------------------------
 
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
@@ -1,8 +1,13 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
 #if __GLASGOW_HASKELL__ >= 701 && __GLASGOW_HASKELL__ != 702
 {-# LANGUAGE Safe #-}
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+#define HAS_SEMIGROUP
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Put
@@ -65,9 +70,13 @@
     , putInt32host          -- :: Int32  -> Put
     , putInt64host          -- :: Int64  -> Put
 
+    -- * Unicode
+    , putCharUtf8
+    , putStringUtf8
+
   ) where
 
-import Data.Monoid
+import qualified Data.Monoid as Monoid
 import Data.Binary.Builder (Builder, toLazyByteString)
 import qualified Data.Binary.Builder as B
 
@@ -79,6 +88,10 @@
 import Data.ByteString.Short
 #endif
 
+#ifdef HAS_SEMIGROUP
+import Data.Semigroup
+#endif
+
 import Control.Applicative
 import Prelude -- Silence AMP warning.
 
@@ -102,18 +115,18 @@
         {-# INLINE fmap #-}
 
 instance Applicative PutM where
-        pure a  = Put $ PairS a mempty
+        pure a  = Put $ PairS a Monoid.mempty
         {-# INLINE pure #-}
 
         m <*> k = Put $
             let PairS f w  = unPut m
                 PairS x w' = unPut k
-            in PairS (f x) (w `mappend` w')
+            in PairS (f x) (w `Monoid.mappend` w')
 
         m *> k  = Put $
             let PairS _ w  = unPut m
                 PairS b w' = unPut k
-            in PairS b (w `mappend` w')
+            in PairS b (w `Monoid.mappend` w')
         {-# INLINE (*>) #-}
 
 -- Standard Writer monad, with aggressive inlining
@@ -121,7 +134,7 @@
     m >>= k  = Put $
         let PairS a w  = unPut m
             PairS b w' = unPut (k a)
-        in PairS b (w `mappend` w')
+        in PairS b (w `Monoid.mappend` w')
     {-# INLINE (>>=) #-}
 
     return = pure
@@ -130,6 +143,30 @@
     (>>) = (*>)
     {-# INLINE (>>) #-}
 
+instance Monoid.Monoid (PutM ()) where
+    mempty = pure ()
+    {-# INLINE mempty #-}
+
+#ifdef HAS_SEMIGROUP
+    mappend = (<>)
+#else
+    mappend = mappend'
+#endif
+    {-# INLINE mappend #-}
+
+mappend' :: Put -> Put -> Put
+mappend' m k = Put $
+    let PairS _ w  = unPut m
+        PairS _ w' = unPut k
+    in PairS () (w `Monoid.mappend` w')
+{-# INLINE mappend' #-}
+
+#ifdef HAS_SEMIGROUP
+instance Semigroup (PutM ()) where
+    (<>) = mappend'
+    {-# INLINE (<>) #-}
+#endif
+
 tell :: Builder -> Put
 tell b = Put $ PairS () b
 {-# INLINE tell #-}
@@ -310,3 +347,17 @@
 putInt64host       :: Int64 -> Put
 putInt64host       = tell . B.putInt64host
 {-# INLINE putInt64host #-}
+
+
+------------------------------------------------------------------------
+-- Unicode
+
+-- | Write a character using UTF-8 encoding.
+putCharUtf8 :: Char -> Put
+putCharUtf8 = tell . B.putCharUtf8
+{-# INLINE putCharUtf8 #-}
+
+-- | Write a String using UTF-8 encoding.
+putStringUtf8 :: String -> Put
+putStringUtf8 = tell . B.putStringUtf8
+{-# INLINE putStringUtf8 #-}
diff --git a/tests/QC.hs b/tests/QC.hs
--- a/tests/QC.hs
+++ b/tests/QC.hs
@@ -414,31 +414,45 @@
 
 ------------------------------------------------------------------------
 
+genInteger :: Gen Integer
+genInteger = do
+  b <- arbitrary
+  if b then genIntegerSmall else genIntegerSmall
+
+genIntegerSmall :: Gen Integer
+genIntegerSmall = arbitrary
+
+genIntegerBig :: Gen Integer
+genIntegerBig = do
+  x <- arbitrarySizedIntegral :: Gen Integer
+  -- arbitrarySizedIntegral generates numbers smaller than
+  -- (maxBound :: Word32), so let's make them bigger to better test
+  -- the Binary instance.
+  return (x + fromIntegral (maxBound :: Word32))
+
 #ifdef HAS_NATURAL
-prop_test_Natural :: Property
-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
+genNatural :: Gen Natural
+genNatural = do
+  b <- arbitrary
+  if b then genNaturalSmall else genNaturalBig
+
+genNaturalSmall :: Gen Natural
+genNaturalSmall = arbitrarySizedNatural
+
+genNaturalBig :: Gen Natural
+genNaturalBig = 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))
 #endif
 
 ------------------------------------------------------------------------
 
 #ifdef HAS_GHC_FINGERPRINT
-prop_test_GHC_Fingerprint :: Property
-prop_test_GHC_Fingerprint = forAll gen test
-  where
-    gen :: Gen Fingerprint
-    gen = liftM2 Fingerprint arbitrary arbitrary
+genFingerprint :: Gen Fingerprint
+genFingerprint = liftM2 Fingerprint arbitrary arbitrary
 #if !MIN_VERSION_base(4,7,0)
 instance Show Fingerprint where
   show (Fingerprint x1 x2) = show (x1,x2)
@@ -480,6 +494,20 @@
 test    :: (Eq a, Binary a) => a -> Property
 test a  = forAll positiveList (roundTrip a . refragment)
 
+test' :: (Show a, Arbitrary a) => String -> (a -> Property) -> ([a] -> Property) -> Test
+test' desc prop propList =
+  testGroup desc [
+    testProperty desc prop,
+    testProperty ("[" ++ desc ++ "]") propList
+  ]
+
+testWithGen :: (Show a, Eq a, Binary a) => String -> Gen a -> Test
+testWithGen desc gen =
+  testGroup desc [
+    testProperty desc (forAll gen test),
+    testProperty ("[" ++ desc ++ "]") (forAll (listOf gen) test)
+  ]
+
 positiveList :: Gen [Int]
 positiveList = fmap (filter (/=0) . map abs) $ arbitrary
 
@@ -541,82 +569,76 @@
             , testProperty "getRemainingLazyByteString" prop_getRemainingLazyByteString
             ]
 
-        , testGroup "Using Binary class, refragmented ByteString" $ map (uncurry testProperty)
-            [ ("()",         p (test :: T ()                     ))
-            , ("Bool",       p (test :: T Bool                   ))
-            , ("Ordering",   p (test :: T Ordering               ))
-            , ("Ratio Int",  p (test :: T (Ratio Int)            ))
+        , testGroup "Using Binary class, refragmented ByteString"
+            [ test' "()"          (test :: T ()         ) test
+            , test' "Bool"        (test :: T Bool       ) test
+            , test' "Char"        (test :: T Char       ) test
+            , test' "Ordering"    (test :: T Ordering   ) test
+            , test' "Ratio Int"   (test :: T (Ratio Int)) test
 
+            , test' "Word"        (test :: T Word  ) test
+            , test' "Word8"       (test :: T Word8 ) test
+            , test' "Word16"      (test :: T Word16) test
+            , test' "Word32"      (test :: T Word32) test
+            , test' "Word64"      (test :: T Word64) test
 
-            , ("Word8",      p (test :: T Word8                  ))
-            , ("Word16",     p (test :: T Word16                 ))
-            , ("Word32",     p (test :: T Word32                 ))
-            , ("Word64",     p (test :: T Word64                 ))
+            , test' "Int"         (test :: T Int  ) test
+            , test' "Int8"        (test :: T Int8 ) test
+            , test' "Int16"       (test :: T Int16) test
+            , test' "Int32"       (test :: T Int32) test
+            , test' "Int64"       (test :: T Int64) test
 
-            , ("Int8",       p (test :: T Int8                   ))
-            , ("Int16",      p (test :: T Int16                  ))
-            , ("Int32",      p (test :: T Int32                  ))
-            , ("Int64",      p (test :: T Int64                  ))
+            , testWithGen "Integer mixed" genInteger
+            , testWithGen "Integer small" genIntegerSmall
+            , testWithGen "Integer big"   genIntegerBig
 
-            , ("Word",       p (test :: T Word                   ))
-            , ("Int",        p (test :: T Int                    ))
-            , ("Integer",    p (test :: T Integer                ))
-            , ("Fixed",      p (test :: T (Fixed.Fixed Fixed.E3) ))
+            , test' "Fixed"       (test :: T (Fixed.Fixed Fixed.E3) ) test
 #ifdef HAS_NATURAL
-            , ("Natural",         prop_test_Natural               )
+            , testWithGen "Natural mixed" genNatural
+            , testWithGen "Natural small" genNaturalSmall
+            , testWithGen "Natural big"   genNaturalBig
 #endif
 #ifdef HAS_GHC_FINGERPRINT
-            , ("GHC.Fingerprint", prop_test_GHC_Fingerprint       )
+            , testWithGen "GHC.Fingerprint" genFingerprint
 #endif
 
-            , ("Float",      p (test :: T Float                  ))
-            , ("Double",     p (test :: T Double                 ))
-
-            , ("Char",       p (test :: T Char                   ))
-
-            , ("[()]",       p (test :: T [()]                  ))
-            , ("[Word8]",    p (test :: T [Word8]               ))
-            , ("[Word32]",   p (test :: T [Word32]              ))
-            , ("[Word64]",   p (test :: T [Word64]              ))
-            , ("[Word]",     p (test :: T [Word]                ))
-            , ("[Int]",      p (test :: T [Int]                 ))
-            , ("[Integer]",  p (test :: T [Integer]             ))
-            , ("String",     p (test :: T String                ))
-            , ("((), ())",           p (test :: T ((), ())        ))
-            , ("(Word8, Word32)",    p (test :: T (Word8, Word32) ))
-            , ("(Int8, Int32)",      p (test :: T (Int8,  Int32)  ))
-            , ("(Int32, [Int])",     p (test :: T (Int32, [Int])  ))
+            , test' "Float"       (test :: T Float ) test
+            , test' "Double"      (test :: T Double) test
 
-            , ("Maybe Int8",         p (test :: T (Maybe Int8)        ))
-            , ("Either Int8 Int16",  p (test :: T (Either Int8 Int16) ))
+            , test' "((), ())"            (test :: T ((), ())            ) test
+            , test' "(Word8, Word32)"     (test :: T (Word8, Word32)     ) test
+            , test' "(Int8, Int32)"       (test :: T (Int8,  Int32)      ) test
+            , test' "(Int32, [Int])"      (test :: T (Int32, [Int])      ) test
+            , test' "Maybe Int8"          (test :: T (Maybe Int8)        ) test
+            , test' "Either Int8 Int16"   (test :: T (Either Int8 Int16) ) test
 
-            , ("(Int, ByteString)",
-                      p (test     :: T (Int, B.ByteString)   ))
-            , ("[(Int, ByteString)]",
-                      p (test     :: T [(Int, B.ByteString)] ))
+            , test' "(Int, ByteString)"
+                    (test     :: T (Int, B.ByteString)   ) test
+            , test' "[(Int, ByteString)]"
+                    (test     :: T [(Int, B.ByteString)] ) test
 
-            , ("(Maybe Int64, Bool, [Int])",
-                      p (test :: T (Maybe Int64, Bool, [Int])))
-            , ("(Maybe Word8, Bool, [Int], Either Bool Word8)",
-                      p (test :: T (Maybe Word8, Bool, [Int], Either Bool Word8) ))
-            , ("(Maybe Word16, Bool, [Int], Either Bool Word16, Int)",
-                      p (test :: T (Maybe Word16, Bool, [Int], Either Bool Word16, Int) ))
+            , test' "(Maybe Int64, Bool, [Int])"
+                    (test :: T (Maybe Int64, Bool, [Int])) test
+            , test' "(Maybe Word8, Bool, [Int], Either Bool Word8)"
+                    (test :: T (Maybe Word8, Bool, [Int], Either Bool Word8)) test
+            , test' "(Maybe Word16, Bool, [Int], Either Bool Word16, Int)"
+                    (test :: T (Maybe Word16, Bool, [Int], Either Bool Word16, Int)) test
 
-            , ("(Int,Int,Int,Int,Int,Int)",
-                      p (test :: T (Int,Int,Int,Int,Int,Int)))
-            , ("(Int,Int,Int,Int,Int,Int,Int)",
-                      p (test :: T (Int,Int,Int,Int,Int,Int,Int)))
-            , ("(Int,Int,Int,Int,Int,Int,Int,Int)",
-                      p (test :: T (Int,Int,Int,Int,Int,Int,Int,Int)))
-            , ("(Int,Int,Int,Int,Int,Int,Int,Int,Int)",
-                      p (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int)))
-            , ("(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)",
-                      p (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)))
+            , test' "(Int,Int,Int,Int,Int,Int)"
+                      (test :: T (Int,Int,Int,Int,Int,Int)) test
+            , test' "(Int,Int,Int,Int,Int,Int,Int)"
+                      (test :: T (Int,Int,Int,Int,Int,Int,Int)) test
+            , test' "(Int,Int,Int,Int,Int,Int,Int,Int)"
+                      (test :: T (Int,Int,Int,Int,Int,Int,Int,Int)) test
+            , test' "(Int,Int,Int,Int,Int,Int,Int,Int,Int)"
+                      (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int)) test
+            , test' "(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)"
+                      (test :: T (Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)) test
 
-            , ("B.ByteString",  p (test :: T B.ByteString        ))
-            , ("L.ByteString",  p (test :: T L.ByteString        ))
+            , test' "B.ByteString" (test :: T B.ByteString) test
+            , test' "L.ByteString" (test :: T L.ByteString) test
 #if MIN_VERSION_bytestring(0,10,4)
-            , ("ShortByteString",  p (test :: T ShortByteString        ))
+            , test' "ShortByteString" (test :: T ShortByteString) test
 #endif
             ]