binary 0.8.2.1 → 0.8.3.0

raw patch · 12 files changed

+715/−827 lines, 12 filesdep ~basedep ~bytestringdep ~criterionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, bytestring, criterion

API changes (from Hackage documentation)

Files

• benchmarks/Builder.hs +0/−6
• benchmarks/Get.hs +2/−2
• benchmarks/Put.hs +188/−0
• binary.cabal +26/−9
• changelog.md +14/−0
• src/Data/Binary/Builder.hs +208/−6
• src/Data/Binary/Builder/Base.hs +0/−621
• src/Data/Binary/Builder/Internal.hs +0/−28
• src/Data/Binary/Class.hs +114/−66
• src/Data/Binary/Generic.hs +5/−4
• src/Data/Binary/Put.hs +56/−5
• tests/QC.hs +102/−80

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 -------------- 

@@ -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 #-}

@@ -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

@@ -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

@@ -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

@@ -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  ------------------------------------------------------------------------ 

@@ -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 #-}

@@ -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             ]