bytestring 0.10.0.2 → 0.10.2.0

raw patch · 41 files changed

+6429/−6110 lines, 41 filesdep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• Data/ByteString.hs +27/−17
• Data/ByteString/Builder.hs +452/−0
• Data/ByteString/Builder/ASCII.hs +270/−0
• Data/ByteString/Builder/Extra.hs +218/−0
• Data/ByteString/Builder/Internal.hs +868/−0
• Data/ByteString/Builder/Prim.hs +776/−0
• Data/ByteString/Builder/Prim/ASCII.hs +287/−0
• Data/ByteString/Builder/Prim/Binary.hs +336/−0
• Data/ByteString/Builder/Prim/Extra.hs +890/−0
• Data/ByteString/Builder/Prim/Internal.hs +361/−0
• Data/ByteString/Builder/Prim/Internal/Base16.hs +116/−0
• Data/ByteString/Builder/Prim/Internal/Floating.hs +55/−0
• Data/ByteString/Builder/Prim/Internal/UncheckedShifts.hs +106/−0
• Data/ByteString/Char8.hs +15/−5
• Data/ByteString/Internal.hs +29/−8
• Data/ByteString/Lazy.hs +12/−2
• Data/ByteString/Lazy/Builder.hs +7/−447
• Data/ByteString/Lazy/Builder/ASCII.hs +9/−263
• Data/ByteString/Lazy/Builder/BasicEncoding.hs +0/−804
• Data/ByteString/Lazy/Builder/BasicEncoding/ASCII.hs +0/−287
• Data/ByteString/Lazy/Builder/BasicEncoding/Binary.hs +0/−336
• Data/ByteString/Lazy/Builder/BasicEncoding/Extras.hs +0/−890
• Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs +0/−353
• Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs +0/−116
• Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs +0/−55
• Data/ByteString/Lazy/Builder/BasicEncoding/Internal/UncheckedShifts.hs +0/−106
• Data/ByteString/Lazy/Builder/Extras.hs +7/−121
• Data/ByteString/Lazy/Builder/Internal.hs +0/−854
• Data/ByteString/Lazy/Char8.hs +13/−4
• Data/ByteString/Unsafe.hs +34/−0
• bench/BenchAll.hs +85/−85
• bench/BoundsCheckFusion.hs +16/−16
• bytestring.cabal +22/−19
• tests/Properties.hs +10/−0
• tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs +385/−0
• tests/builder/Data/ByteString/Builder/Prim/Tests.hs +337/−0
• tests/builder/Data/ByteString/Builder/Tests.hs +681/−0
• tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/TestUtils.hs +0/−344
• tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/Tests.hs +0/−337
• tests/builder/Data/ByteString/Lazy/Builder/Tests.hs +0/−636
• tests/builder/TestSuite.hs +5/−5

@@ -56,6 +56,7 @@         append,                 -- :: ByteString -> ByteString -> ByteString         head,                   -- :: ByteString -> Word8         uncons,                 -- :: ByteString -> Maybe (Word8, ByteString)+        unsnoc,                 -- :: ByteString -> Maybe (ByteString, Word8)         last,                   -- :: ByteString -> Word8         tail,                   -- :: ByteString -> ByteString         init,                   -- :: ByteString -> ByteString@@ -270,7 +271,7 @@ import GHC.IO.Handle.Types import GHC.IO.Buffer import GHC.IO.BufferedIO as Buffered-import GHC.IO                   (unsafePerformIO, unsafeDupablePerformIO)+import GHC.IO                   (unsafePerformIO) import Data.Char                (ord) import Foreign.Marshal.Utils    (copyBytes) #else@@ -300,10 +301,6 @@ hWaitForInput _ _ = return () #endif -#ifndef __GLASGOW_HASKELL__-unsafeDupablePerformIO = unsafePerformIO-#endif- -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns@@ -467,6 +464,16 @@     | otherwise = PS p s (l-1) {-# INLINE init #-} +-- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning Nothing+-- if it is empty.+unsnoc :: ByteString -> Maybe (ByteString, Word8)+unsnoc (PS x s l)+    | l <= 0    = Nothing+    | otherwise = Just (PS x s (l-1),+                        inlinePerformIO $ withForeignPtr x+                                        $ \p -> peekByteOff p (s+l-1))+{-# INLINE unsnoc #-}+ -- | /O(n)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString append = mappend@@ -476,9 +483,9 @@ -- Transformations  -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each--- element of @xs@.+-- element of @xs@. This function is subject to array fusion. map :: (Word8 -> Word8) -> ByteString -> ByteString-map f (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->+map f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->     create len $ map_ 0 (a `plusPtr` s)   where     map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()@@ -518,6 +525,8 @@ -- the left-identity of the operator), and a ByteString, reduces the -- ByteString using the binary operator, from left to right. --+-- This function is subject to array fusion.+-- foldl :: (a -> Word8 -> a) -> a -> ByteString -> a foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->         lgo v (ptr `plusPtr` s) (ptr `plusPtr` (s+l))@@ -561,6 +570,7 @@  -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'.+-- This function is subject to array fusion.  -- An exception will be thrown in the case of an empty ByteString. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 f ps@@ -582,7 +592,7 @@ foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1 f ps     | null ps        = errorEmptyList "foldr1"-    | otherwise      = foldr f (last ps) (init ps)+    | otherwise      = foldr f (unsafeLast ps) (unsafeInit ps) {-# INLINE foldr1 #-}  -- | 'foldr1\'' is a variant of 'foldr1', but is strict in the@@ -590,7 +600,7 @@ foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1' f ps     | null ps        = errorEmptyList "foldr1"-    | otherwise      = foldr' f (last ps) (init ps)+    | otherwise      = foldr' f (unsafeLast ps) (unsafeInit ps) {-# INLINE foldr1' #-}  -- ---------------------------------------------------------------------@@ -666,7 +676,7 @@ -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new list. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumL f acc (PS fp o len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do+mapAccumL f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do     gp   <- mallocByteString len     acc' <- withForeignPtr gp $ \p -> mapAccumL_ acc 0 (a `plusPtr` o) p     return $! (acc', PS gp 0 len)@@ -686,7 +696,7 @@ -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumR f acc (PS fp o len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do+mapAccumR f acc (PS fp o len) = inlinePerformIO $ withForeignPtr fp $ \a -> do     gp   <- mallocByteString len     acc' <- withForeignPtr gp $ \p -> mapAccumR_ acc (len-1) (a `plusPtr` o) p     return $! (acc', PS gp 0 len)@@ -715,7 +725,7 @@ -- scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString -scanl f v (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->+scanl f v (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->     create (len+1) $ \q -> do         poke q v         scanl_ v 0 (a `plusPtr` s) (q `plusPtr` 1)@@ -746,7 +756,7 @@  -- | scanr is the right-to-left dual of scanl. scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString-scanr f v (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->+scanr f v (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->     create (len+1) $ \q -> do         poke (q `plusPtr` len) v         scanr_ v (len-1) (a `plusPtr` s) q@@ -765,7 +775,7 @@ scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString scanr1 f ps     | null ps   = empty-    | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions+    | otherwise = scanr f (unsafeLast ps) (unsafeInit ps) {-# INLINE scanr1 #-}  -- ---------------------------------------------------------------------@@ -1257,7 +1267,7 @@  -- | /O(n)/ 'filter', applied to a predicate and a ByteString, -- returns a ByteString containing those characters that satisfy the--- predicate.+-- predicate. This function is subject to array fusion. filter :: (Word8 -> Bool) -> ByteString -> ByteString filter k ps@(PS x s l)     | null ps   = ps@@ -1499,7 +1509,7 @@ -- performed on the result of zipWith. -- zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString-zipWith' f (PS fp s l) (PS fq t m) = unsafeDupablePerformIO $+zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $     withForeignPtr fp $ \a ->     withForeignPtr fq $ \b ->     create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t)@@ -2022,5 +2032,5 @@ STRICT2(findFromEndUntil) findFromEndUntil f ps@(PS x s l) =     if null ps then 0-    else if f (last ps) then l+    else if f (unsafeLast ps) then l          else findFromEndUntil f (PS x s (l-1))

@@ -0,0 +1,452 @@+{-# LANGUAGE CPP, BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{- | Copyright   : (c) 2010 Jasper Van der Jeugt+                   (c) 2010 - 2011 Simon Meier+License     : BSD3-style (see LICENSE)+Maintainer  : Simon Meier <iridcode@gmail.com>+Portability : GHC++'Builder's are used to efficiently construct sequences of bytes from+  smaller parts.+Typically,+  such a construction is part of the implementation of an /encoding/, i.e.,+  a function for converting Haskell values to sequences of bytes.+Examples of encodings are the generation of the sequence of bytes+  representing a HTML document to be sent in a HTTP response by a+  web application or the serialization of a Haskell value using+  a fixed binary format.++For an /efficient implementation of an encoding/,+  it is important that (a) little time is spent on converting+  the Haskell values to the resulting sequence of bytes /and/+  (b) that the representation of the resulting sequence+  is such that it can be consumed efficiently.+'Builder's support (a) by providing an /O(1)/ concatentation operation+  and efficient implementations of basic encodings for 'Char's, 'Int's,+  and other standard Haskell values.+They support (b) by providing their result as a lazy 'L.ByteString',+  which is internally just a linked list of pointers to /chunks/+  of consecutive raw memory.+Lazy 'L.ByteString's can be efficiently consumed by functions that+  write them to a file or send them over a network socket.+Note that each chunk boundary incurs expensive extra work (e.g., a system call)+  that must be amortized over the work spent on consuming the chunk body.+'Builder's therefore take special care to ensure that the+  average chunk size is large enough.+The precise meaning of large enough is application dependent.+The current implementation is tuned+  for an average chunk size between 4kb and 32kb,+  which should suit most applications.++As a simple example of an encoding implementation,+  we show how to efficiently convert the following representation of mixed-data+  tables to an UTF-8 encoded Comma-Separated-Values (CSV) table.++>data Cell = StringC String+>          | IntC Int+>          deriving( Eq, Ord, Show )+>+>type Row   = [Cell]+>type Table = [Row]++We use the following imports and abbreviate 'mappend' to simplify reading.++@+import qualified "Data.ByteString.Lazy"               as L+import           "Data.ByteString.Builder"+import           "Data.ByteString.Builder.ASCII" ('intDec')+import           Data.Monoid+import           Data.Foldable                        ('foldMap')+import           Data.List                            ('intersperse')++infixr 4 \<\>+(\<\>) :: 'Monoid' m => m -> m -> m+(\<\>) = 'mappend'+@++CSV is a character-based representation of tables. For maximal modularity,+we could first render 'Table's as 'String's and then encode this 'String'+using some Unicode character encoding. However, this sacrifices performance+due to the intermediate 'String' representation being built and thrown away+right afterwards. We get rid of this intermediate 'String' representation by+fixing the character encoding to UTF-8 and using 'Builder's to convert+'Table's directly to UTF-8 encoded CSV tables represented as lazy+'L.ByteString's.++@+encodeUtf8CSV :: Table -> L.ByteString+encodeUtf8CSV = 'toLazyByteString' . renderTable++renderTable :: Table -> Builder+renderTable rs = 'mconcat' [renderRow r \<\> 'charUtf8' \'\\n\' | r <- rs]++renderRow :: Row -> Builder+renderRow []     = 'mempty'+renderRow (c:cs) =+    renderCell c \<\> mconcat [ charUtf8 \',\' \<\> renderCell c\' | c\' <- cs ]++renderCell :: Cell -> Builder+renderCell (StringC cs) = renderString cs+renderCell (IntC i)     = 'intDec' i++renderString :: String -> Builder+renderString cs = charUtf8 \'\"\' \<\> foldMap escape cs \<\> charUtf8 \'\"\'+  where+    escape \'\\\\\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\\\'+    escape \'\\\"\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\"\'+    escape c    = charUtf8 c+@++Note that the ASCII encoding is a subset of the UTF-8 encoding,+  which is why we can use the optimized function 'intDec' to+  encode an 'Int' as a decimal number with UTF-8 encoded digits.+Using 'intDec' is more efficient than @'stringUtf8' . 'show'@,+  as it avoids constructing an intermediate 'String'.+Avoiding this intermediate data structure significantly improves+  performance because encoding 'Cell's is the core operation+  for rendering CSV-tables.+See "Data.ByteString.Builder.Prim" for further+  information on how to improve the performance of 'renderString'.++We demonstrate our UTF-8 CSV encoding function on the following table.++@+strings :: [String]+strings =  [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]++table :: Table+table = [map StringC strings, map IntC [-3..3]]+@++The expression @encodeUtf8CSV table@ results in the following lazy+'L.ByteString'.++>Chunk "\"hello\",\"\\\"1\\\"\",\"\206\187-w\195\182rld\"\n-3,-2,-1,0,1,2,3\n" Empty++We can clearly see that we are converting to a /binary/ format. The \'&#955;\'+and \'&#246;\' characters, which have a Unicode codepoint above 127, are+expanded to their corresponding UTF-8 multi-byte representation.++We use the @criterion@ library (<http://hackage.haskell.org/package/criterion>)+  to benchmark the efficiency of our encoding function on the following table.++>import Criterion.Main     -- add this import to the ones above+>+>maxiTable :: Table+>maxiTable = take 1000 $ cycle table+>+>main :: IO ()+>main = defaultMain+>  [ bench "encodeUtf8CSV maxiTable (original)" $+>      whnf (L.length . encodeUtf8CSV) maxiTable+>  ]++On a Core2 Duo 2.20GHz on a 32-bit Linux,+  the above code takes 1ms to generate the 22'500 bytes long lazy 'L.ByteString'.+Looking again at the definitions above,+  we see that we took care to avoid intermediate data structures,+  as otherwise we would sacrifice performance.+For example,+  the following (arguably simpler) definition of 'renderRow' is about 20% slower.++>renderRow :: Row -> Builder+>renderRow  = mconcat . intersperse (charUtf8 ',') . map renderCell++Similarly, using /O(n)/ concatentations like '++' or the equivalent 'S.concat'+  operations on strict and lazy 'L.ByteString's should be avoided.+The following definition of 'renderString' is also about 20% slower.++>renderString :: String -> Builder+>renderString cs = charUtf8 $ "\"" ++ concatMap escape cs ++ "\""+>  where+>    escape '\\' = "\\"+>    escape '\"' = "\\\""+>    escape c    = return c++Apart from removing intermediate data-structures,+  encodings can be optimized further by fine-tuning their execution+  parameters using the functions in "Data.ByteString.Builder.Extra" and+  their \"inner loops\" using the functions in+  "Data.ByteString.Builder.Prim".+-}+++module Data.ByteString.Builder+    (+      -- * The Builder type+      Builder++      -- * Executing Builders+      -- | Internally, 'Builder's are buffer-filling functions. They are+      -- executed by a /driver/ that provides them with an actual buffer to+      -- fill. Once called with a buffer, a 'Builder' fills it and returns a+      -- signal to the driver telling it that it is either done, has filled the+      -- current buffer, or wants to directly insert a reference to a chunk of+      -- memory. In the last two cases, the 'Builder' also returns a+      -- continutation 'Builder' that the driver can call to fill the next+      -- buffer. Here, we provide the two drivers that satisfy almost all use+      -- cases. See "Data.ByteString.Builder.Extra", for information+      -- about fine-tuning them.+    , toLazyByteString+    , hPutBuilder++      -- * Creating Builders++      -- ** Binary encodings+    , byteString+    , lazyByteString+    , int8+    , word8++      -- *** Big-endian+    , int16BE+    , int32BE+    , int64BE++    , word16BE+    , word32BE+    , word64BE++    , floatBE+    , doubleBE++      -- *** Little-endian+    , int16LE+    , int32LE+    , int64LE++    , word16LE+    , word32LE+    , word64LE++    , floatLE+    , doubleLE++    -- ** Character encodings++    -- *** ASCII (Char7)+    -- | The ASCII encoding is a 7-bit encoding. The /Char7/ encoding implemented here+    -- works by truncating the Unicode codepoint to 7-bits, prefixing it+    -- with a leading 0, and encoding the resulting 8-bits as a single byte.+    -- For the codepoints 0-127 this corresponds the ASCII encoding. In+    -- "Data.ByteString.Builder.ASCII", we also provide efficient+    -- implementations of ASCII-based encodings of numbers (e.g., decimal and+    -- hexadecimal encodings).+    , char7+    , string7++    -- *** ISO/IEC 8859-1 (Char8)+    -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.+    -- The /Char8/ encoding implemented here works by truncating the Unicode codepoint+    -- to 8-bits and encoding them as a single byte. For the codepoints 0-255 this corresponds+    -- to the ISO/IEC 8859-1 encoding. Note that you can also use+    -- the functions from "Data.ByteString.Builder.ASCII", as the ASCII encoding+    -- and ISO/IEC 8859-1 are equivalent on the codepoints 0-127.+    , char8+    , string8++    -- *** UTF-8+    -- | The UTF-8 encoding can encode /all/ Unicode codepoints. We recommend+    -- using it always for encoding 'Char's and 'String's unless an application+    -- really requires another encoding. Note that you can also use the+    -- functions from "Data.ByteString.Builder.ASCII" for UTF-8 encoding,+    -- as the ASCII encoding is equivalent to the UTF-8 encoding on the Unicode+    -- codepoints 0-127.+    , charUtf8+    , stringUtf8++    , module Data.ByteString.Builder.ASCII++    ) where++import           Data.ByteString.Builder.Internal+import qualified Data.ByteString.Builder.Prim  as P+import qualified Data.ByteString.Lazy.Internal as L++import           System.IO (Handle)+import           Foreign++-- HADDOCK only imports+import           Data.ByteString.Builder.ASCII (intDec)+import qualified Data.ByteString               as S (concat)+import           Data.Monoid+import           Data.Foldable                      (foldMap)+import           Data.List                          (intersperse)+++-- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'.+-- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString'+-- is forced.+{-# NOINLINE toLazyByteString #-} -- ensure code is shared+toLazyByteString :: Builder -> L.ByteString+toLazyByteString = toLazyByteStringWith+    (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty++{- Not yet stable enough.+   See note on 'hPut' in Data.ByteString.Builder.Internal+-}++-- | Output a 'Builder' to a 'Handle'.+-- The 'Builder' is executed directly on the buffer of the 'Handle'. If the+-- buffer is too small (or not present), then it is replaced with a large+-- enough buffer.+--+-- It is recommended that the 'Handle' is set to binary and+-- 'BlockBuffering' mode. See 'hSetBinaryMode' and 'hSetBuffering'.+--+-- This function is more efficient than @hPut . 'toLazyByteString'@ because in+-- many cases no buffer allocation has to be done. Moreover, the results of+-- several executions of short 'Builder's are concatenated in the 'Handle's+-- buffer, therefore avoiding unnecessary buffer flushes.+hPutBuilder :: Handle -> Builder -> IO ()+hPutBuilder h = hPut h . putBuilder+++------------------------------------------------------------------------------+-- Binary encodings+------------------------------------------------------------------------------++-- | Encode a single signed byte as-is.+--+{-# INLINE int8 #-}+int8 :: Int8 -> Builder+int8 = P.primFixed P.int8++-- | Encode a single unsigned byte as-is.+--+{-# INLINE word8 #-}+word8 :: Word8 -> Builder+word8 = P.primFixed P.word8+++------------------------------------------------------------------------------+-- Binary little-endian encodings+------------------------------------------------------------------------------++-- | Encode an 'Int16' in little endian format.+{-# INLINE int16LE #-}+int16LE :: Int16 -> Builder+int16LE = P.primFixed P.int16LE++-- | Encode an 'Int32' in little endian format.+{-# INLINE int32LE #-}+int32LE :: Int32 -> Builder+int32LE = P.primFixed P.int32LE++-- | Encode an 'Int64' in little endian format.+{-# INLINE int64LE #-}+int64LE :: Int64 -> Builder+int64LE = P.primFixed P.int64LE++-- | Encode a 'Word16' in little endian format.+{-# INLINE word16LE #-}+word16LE :: Word16 -> Builder+word16LE = P.primFixed P.word16LE++-- | Encode a 'Word32' in little endian format.+{-# INLINE word32LE #-}+word32LE :: Word32 -> Builder+word32LE = P.primFixed P.word32LE++-- | Encode a 'Word64' in little endian format.+{-# INLINE word64LE #-}+word64LE :: Word64 -> Builder+word64LE = P.primFixed P.word64LE++-- | Encode a 'Float' in little endian format.+{-# INLINE floatLE #-}+floatLE :: Float -> Builder+floatLE = P.primFixed P.floatLE++-- | Encode a 'Double' in little endian format.+{-# INLINE doubleLE #-}+doubleLE :: Double -> Builder+doubleLE = P.primFixed P.doubleLE+++------------------------------------------------------------------------------+-- Binary big-endian encodings+------------------------------------------------------------------------------++-- | Encode an 'Int16' in big endian format.+{-# INLINE int16BE #-}+int16BE :: Int16 -> Builder+int16BE = P.primFixed P.int16BE++-- | Encode an 'Int32' in big endian format.+{-# INLINE int32BE #-}+int32BE :: Int32 -> Builder+int32BE = P.primFixed P.int32BE++-- | Encode an 'Int64' in big endian format.+{-# INLINE int64BE #-}+int64BE :: Int64 -> Builder+int64BE = P.primFixed P.int64BE++-- | Encode a 'Word16' in big endian format.+{-# INLINE word16BE #-}+word16BE :: Word16 -> Builder+word16BE = P.primFixed P.word16BE++-- | Encode a 'Word32' in big endian format.+{-# INLINE word32BE #-}+word32BE :: Word32 -> Builder+word32BE = P.primFixed P.word32BE++-- | Encode a 'Word64' in big endian format.+{-# INLINE word64BE #-}+word64BE :: Word64 -> Builder+word64BE = P.primFixed P.word64BE++-- | Encode a 'Float' in big endian format.+{-# INLINE floatBE #-}+floatBE :: Float -> Builder+floatBE = P.primFixed P.floatBE++-- | Encode a 'Double' in big endian format.+{-# INLINE doubleBE #-}+doubleBE :: Double -> Builder+doubleBE = P.primFixed P.doubleBE++------------------------------------------------------------------------------+-- ASCII encoding+------------------------------------------------------------------------------++-- | Char7 encode a 'Char'.+{-# INLINE char7 #-}+char7 :: Char -> Builder+char7 = P.primFixed P.char7++-- | Char7 encode a 'String'.+{-# INLINE string7 #-}+string7 :: String -> Builder+string7 = P.primMapListFixed P.char7++------------------------------------------------------------------------------+-- ISO/IEC 8859-1 encoding+------------------------------------------------------------------------------++-- | Char8 encode a 'Char'.+{-# INLINE char8 #-}+char8 :: Char -> Builder+char8 = P.primFixed P.char8++-- | Char8 encode a 'String'.+{-# INLINE string8 #-}+string8 :: String -> Builder+string8 = P.primMapListFixed P.char8++------------------------------------------------------------------------------+-- UTF-8 encoding+------------------------------------------------------------------------------++-- | UTF-8 encode a 'Char'.+{-# INLINE charUtf8 #-}+charUtf8 :: Char -> Builder+charUtf8 = P.primBounded P.charUtf8++-- | UTF-8 encode a 'String'.+{-# INLINE stringUtf8 #-}+stringUtf8 :: String -> Builder+stringUtf8 = P.primMapListBounded P.charUtf8+

@@ -0,0 +1,270 @@+{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}+{-# OPTIONS_HADDOCK hide #-}+-- | Copyright : (c) 2010 - 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Constructing 'Builder's using ASCII-based encodings.+--+module Data.ByteString.Builder.ASCII+    (+      -- ** ASCII text+      -- *** Decimal numbers+      -- | Decimal encoding of numbers using ASCII encoded characters.+      int8Dec+    , int16Dec+    , int32Dec+    , int64Dec+    , intDec+    , integerDec++    , word8Dec+    , word16Dec+    , word32Dec+    , word64Dec+    , wordDec++    , floatDec+    , doubleDec++      -- *** Hexadecimal numbers++      -- | Encoding positive integers as hexadecimal numbers using lower-case+      -- ASCII characters. The shortest+      -- possible representation is used. For example,+      --+      -- >>> toLazyByteString (word16Hex 0x0a10)+      -- Chunk "a10" Empty+      --+      -- Note that there is no support for using upper-case characters. Please+      -- contact the maintainer, if your application cannot work without+      -- hexadecimal encodings that use upper-case characters.+      --+    , word8Hex+    , word16Hex+    , word32Hex+    , word64Hex+    , wordHex++      -- *** Fixed-width hexadecimal numbers+      --+    , int8HexFixed+    , int16HexFixed+    , int32HexFixed+    , int64HexFixed+    , word8HexFixed+    , word16HexFixed+    , word32HexFixed+    , word64HexFixed++    , floatHexFixed+    , doubleHexFixed++    , byteStringHex+    , lazyByteStringHex++    ) where++import           Data.ByteString                             as S+import           Data.ByteString.Lazy.Internal               as L+import           Data.ByteString.Builder.Internal (Builder)+import qualified Data.ByteString.Builder.Prim                as P++import           Foreign++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------+++-- | Encode a 'String' using 'P.char7'.+{-# INLINE string7 #-}+string7 :: String -> Builder+string7 = P.primMapListFixed P.char7++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------++-- Signed integers+------------------++-- | Decimal encoding of an 'Int8' using the ASCII digits.+--+-- e.g.+--+-- > toLazyByteString (int8Dec 42)   = "42"+-- > toLazyByteString (int8Dec (-1)) = "-1"+--+{-# INLINE int8Dec #-}+int8Dec :: Int8 -> Builder+int8Dec = P.primBounded P.int8Dec++-- | Decimal encoding of an 'Int16' using the ASCII digits.+{-# INLINE int16Dec #-}+int16Dec :: Int16 -> Builder+int16Dec = P.primBounded P.int16Dec++-- | Decimal encoding of an 'Int32' using the ASCII digits.+{-# INLINE int32Dec #-}+int32Dec :: Int32 -> Builder+int32Dec = P.primBounded P.int32Dec++-- | Decimal encoding of an 'Int64' using the ASCII digits.+{-# INLINE int64Dec #-}+int64Dec :: Int64 -> Builder+int64Dec = P.primBounded P.int64Dec++-- | Decimal encoding of an 'Int' using the ASCII digits.+{-# INLINE intDec #-}+intDec :: Int -> Builder+intDec = P.primBounded P.intDec++-- | /Currently slow./ Decimal encoding of an 'Integer' using the ASCII digits.+{-# INLINE integerDec #-}+integerDec :: Integer -> Builder+integerDec =  string7 . show+++-- Unsigned integers+--------------------++-- | Decimal encoding of a 'Word8' using the ASCII digits.+{-# INLINE word8Dec #-}+word8Dec :: Word8 -> Builder+word8Dec = P.primBounded P.word8Dec++-- | Decimal encoding of a 'Word16' using the ASCII digits.+{-# INLINE word16Dec #-}+word16Dec :: Word16 -> Builder+word16Dec = P.primBounded P.word16Dec++-- | Decimal encoding of a 'Word32' using the ASCII digits.+{-# INLINE word32Dec #-}+word32Dec :: Word32 -> Builder+word32Dec = P.primBounded P.word32Dec++-- | Decimal encoding of a 'Word64' using the ASCII digits.+{-# INLINE word64Dec #-}+word64Dec :: Word64 -> Builder+word64Dec = P.primBounded P.word64Dec++-- | Decimal encoding of a 'Word' using the ASCII digits.+{-# INLINE wordDec #-}+wordDec :: Word -> Builder+wordDec = P.primBounded P.wordDec+++-- Floating point numbers+-------------------------++-- TODO: Use Bryan O'Sullivan's double-conversion package to speed it up.++-- | /Currently slow./ Decimal encoding of an IEEE 'Float'.+{-# INLINE floatDec #-}+floatDec :: Float -> Builder+floatDec = string7 . show++-- | /Currently slow./ Decimal encoding of an IEEE 'Double'.+{-# INLINE doubleDec #-}+doubleDec :: Double -> Builder+doubleDec = string7 . show+++------------------------------------------------------------------------------+-- Hexadecimal Encoding+------------------------------------------------------------------------------++-- without lead+---------------++-- | Shortest hexadecimal encoding of a 'Word8' using lower-case characters.+{-# INLINE word8Hex #-}+word8Hex :: Word8 -> Builder+word8Hex = P.primBounded P.word8Hex++-- | Shortest hexadecimal encoding of a 'Word16' using lower-case characters.+{-# INLINE word16Hex #-}+word16Hex :: Word16 -> Builder+word16Hex = P.primBounded P.word16Hex++-- | Shortest hexadecimal encoding of a 'Word32' using lower-case characters.+{-# INLINE word32Hex #-}+word32Hex :: Word32 -> Builder+word32Hex = P.primBounded P.word32Hex++-- | Shortest hexadecimal encoding of a 'Word64' using lower-case characters.+{-# INLINE word64Hex #-}+word64Hex :: Word64 -> Builder+word64Hex = P.primBounded P.word64Hex++-- | Shortest hexadecimal encoding of a 'Word' using lower-case characters.+{-# INLINE wordHex #-}+wordHex :: Word -> Builder+wordHex = P.primBounded P.wordHex+++-- fixed width; leading zeroes+------------------------------++-- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).+{-# INLINE int8HexFixed #-}+int8HexFixed :: Int8 -> Builder+int8HexFixed = P.primFixed P.int8HexFixed++-- | Encode a 'Int16' using 4 nibbles.+{-# INLINE int16HexFixed #-}+int16HexFixed :: Int16 -> Builder+int16HexFixed = P.primFixed P.int16HexFixed++-- | Encode a 'Int32' using 8 nibbles.+{-# INLINE int32HexFixed #-}+int32HexFixed :: Int32 -> Builder+int32HexFixed = P.primFixed P.int32HexFixed++-- | Encode a 'Int64' using 16 nibbles.+{-# INLINE int64HexFixed #-}+int64HexFixed :: Int64 -> Builder+int64HexFixed = P.primFixed P.int64HexFixed++-- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).+{-# INLINE word8HexFixed #-}+word8HexFixed :: Word8 -> Builder+word8HexFixed = P.primFixed P.word8HexFixed++-- | Encode a 'Word16' using 4 nibbles.+{-# INLINE word16HexFixed #-}+word16HexFixed :: Word16 -> Builder+word16HexFixed = P.primFixed P.word16HexFixed++-- | Encode a 'Word32' using 8 nibbles.+{-# INLINE word32HexFixed #-}+word32HexFixed :: Word32 -> Builder+word32HexFixed = P.primFixed P.word32HexFixed++-- | Encode a 'Word64' using 16 nibbles.+{-# INLINE word64HexFixed #-}+word64HexFixed :: Word64 -> Builder+word64HexFixed = P.primFixed P.word64HexFixed++-- | Encode an IEEE 'Float' using 8 nibbles.+{-# INLINE floatHexFixed #-}+floatHexFixed :: Float -> Builder+floatHexFixed = P.primFixed P.floatHexFixed++-- | Encode an IEEE 'Double' using 16 nibbles.+{-# INLINE doubleHexFixed #-}+doubleHexFixed :: Double -> Builder+doubleHexFixed = P.primFixed P.doubleHexFixed++-- | Encode each byte of a 'S.ByteString' using its fixed-width hex encoding.+{-# NOINLINE byteStringHex #-} -- share code+byteStringHex :: S.ByteString -> Builder+byteStringHex = P.primMapByteStringFixed P.word8HexFixed++-- | Encode each byte of a lazy 'L.ByteString' using its fixed-width hex encoding.+{-# NOINLINE lazyByteStringHex #-} -- share code+lazyByteStringHex :: L.ByteString -> Builder+lazyByteStringHex = P.primMapLazyByteStringFixed P.word8HexFixed

@@ -0,0 +1,218 @@+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- | Copyright : (c) 2010      Jasper Van der Jeugt+--               (c) 2010-2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Extra functions for creating and executing 'Builder's. They are intended+-- for application-specific fine-tuning the performance of 'Builder's.+--+-----------------------------------------------------------------------------+module Data.ByteString.Builder.Extra+    (+    -- * Execution strategies+      toLazyByteStringWith+    , AllocationStrategy+    , safeStrategy+    , untrimmedStrategy+    , smallChunkSize+    , defaultChunkSize++    -- * Controlling chunk boundaries+    , byteStringCopy+    , byteStringInsert+    , byteStringThreshold++    , lazyByteStringCopy+    , lazyByteStringInsert+    , lazyByteStringThreshold++    , flush++    -- * Low level execution+    , BufferWriter+    , Next(..)+    , runBuilder++    -- * Host-specific binary encodings+    , intHost+    , int16Host+    , int32Host+    , int64Host++    , wordHost+    , word16Host+    , word32Host+    , word64Host++    , floatHost+    , doubleHost++    ) where+++import Data.ByteString.Builder.Internal+         ( Builder, toLazyByteStringWith+         , AllocationStrategy, safeStrategy, untrimmedStrategy+         , smallChunkSize, defaultChunkSize, flush+         , byteStringCopy, byteStringInsert, byteStringThreshold+         , lazyByteStringCopy, lazyByteStringInsert, lazyByteStringThreshold )++import qualified Data.ByteString.Builder.Internal as I+import qualified Data.ByteString.Builder.Prim  as P+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L+++import Foreign++------------------------------------------------------------------------------+-- Builder execution public API+------------------------------------------------------------------------------++-- | A 'BufferWriter' represents the result of running a 'Builder'.+-- It unfolds as a sequence of chunks of data. These chunks come in two forms:+--+--  * an IO action for writing the Builder's data into a user-supplied memory+--    buffer.+--+--  * a pre-existing chunks of data represented by a strict 'ByteString'+--+-- While this is rather low level, it provides you with full flexibility in+-- how the data is written out.+--+-- The 'BufferWriter' itself is an IO action: you supply it with a buffer+-- (as a pointer and length) and it will write data into the buffer.+-- It returns a number indicating how many bytes were actually written+-- (which can be @0@). It also returns a 'Next' which describes what+-- comes next.+--+type BufferWriter = Ptr Word8 -> Int -> IO (Int, Next)++-- | After running a 'BufferWriter' action there are three possibilities for+-- what comes next:+--+data Next =+     -- | This means we're all done. All the builder data has now been written.+     Done++     -- | This indicates that there may be more data to write. It+     -- gives you the next 'BufferWriter' action. You should call that action+     -- with an appropriate buffer. The int indicates the /minimum/ buffer size+     -- required by the next 'BufferWriter' action. That is, if you call the next+     -- action you /must/ supply it with a buffer length of at least this size.+   | More   !Int          BufferWriter++     -- | In addition to the data that has just been written into your buffer+     -- by the 'BufferWriter' action, it gives you a pre-existing chunk+     -- of data as a 'S.ByteString'. It also gives you the following 'BufferWriter'+     -- action. It is safe to run this following action using a buffer with as+     -- much free space as was left by the previous run action.+   | Chunk  !S.ByteString BufferWriter++-- | Turn a 'Builder' into its initial 'BufferWriter' action.+--+runBuilder :: Builder -> BufferWriter+runBuilder = run . I.runBuilder+  where+    run :: I.BuildStep () -> BufferWriter+    run step = \buf len -> do+      sig <- step (I.BufferRange buf (buf `plusPtr` len))+      case sig of+        I.Done endPtr () ->+          let !wc  = bytesWritten buf endPtr+              next = Done+           in return (wc, next)++        I.BufferFull minReq endPtr step' ->+          let !wc  = bytesWritten buf endPtr+              next = More minReq (run step')+           in return (wc, next)++        I.InsertChunks endPtr _ lbsc step' ->+          let !wc  = bytesWritten buf endPtr+              next = case lbsc L.Empty of+                       L.Empty      -> More  (len - wc) (run step')+                       L.Chunk c cs -> Chunk c          (yieldChunks step' cs)+           in return (wc, next)++    yieldChunks :: I.BuildStep () -> L.ByteString -> BufferWriter+    yieldChunks step' cs = \buf len ->+      case cs of+        L.Empty       -> run step' buf len+        L.Chunk c cs' ->+          let wc   = 0+              next = Chunk c (yieldChunks step' cs')+           in return (wc, next)++    bytesWritten startPtr endPtr = endPtr `minusPtr` startPtr+++------------------------------------------------------------------------------+-- Host-specific encodings+------------------------------------------------------------------------------++-- | Encode a single native machine 'Int'. The 'Int' is encoded 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 encoded this way+-- are not portable to different endian or int sized machines, without+-- conversion.+--+{-# INLINE intHost #-}+intHost :: Int -> Builder+intHost = P.primFixed P.intHost++-- | Encode a 'Int16' in native host order and host endianness.+{-# INLINE int16Host #-}+int16Host :: Int16 -> Builder+int16Host = P.primFixed P.int16Host++-- | Encode a 'Int32' in native host order and host endianness.+{-# INLINE int32Host #-}+int32Host :: Int32 -> Builder+int32Host = P.primFixed P.int32Host++-- | Encode a 'Int64' in native host order and host endianness.+{-# INLINE int64Host #-}+int64Host :: Int64 -> Builder+int64Host = P.primFixed P.int64Host++-- | Encode a single native machine 'Word'. The 'Word' is encoded 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 encoded this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+{-# INLINE wordHost #-}+wordHost :: Word -> Builder+wordHost = P.primFixed P.wordHost++-- | Encode a 'Word16' in native host order and host endianness.+{-# INLINE word16Host #-}+word16Host :: Word16 -> Builder+word16Host = P.primFixed P.word16Host++-- | Encode a 'Word32' in native host order and host endianness.+{-# INLINE word32Host #-}+word32Host :: Word32 -> Builder+word32Host = P.primFixed P.word32Host++-- | Encode a 'Word64' in native host order and host endianness.+{-# INLINE word64Host #-}+word64Host :: Word64 -> Builder+word64Host = P.primFixed P.word64Host++-- | Encode a 'Float' in native host order. Values encoded this way are not+-- portable to different endian machines, without conversion.+{-# INLINE floatHost #-}+floatHost :: Float -> Builder+floatHost = P.primFixed P.floatHost++-- | Encode a 'Double' in native host order.+{-# INLINE doubleHost #-}+doubleHost :: Double -> Builder+doubleHost = P.primFixed P.doubleHost+

@@ -0,0 +1,868 @@+{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-- | Copyright : (c) 2010 - 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : unstable, private+-- Portability : GHC+--+-- *Warning:* this module is internal. If you find that you need it then please+-- contact the maintainers and explain what you are trying to do and discuss+-- what you would need in the public API. It is important that you do this as+-- the module may not be exposed at all in future releases.+--+-- Core types and functions for the 'Builder' monoid and its generalization,+-- the 'Put' monad.+--+-- The design of the 'Builder' monoid is optimized such that+--+--   1. buffers of arbitrary size can be filled as efficiently as possible and+--+--   2. sequencing of 'Builder's is as cheap as possible.+--+-- We achieve (1) by completely handing over control over writing to the buffer+-- to the 'BuildStep' implementing the 'Builder'. This 'BuildStep' is just told+-- the start and the end of the buffer (represented as a 'BufferRange'). Then,+-- the 'BuildStep' can write to as big a prefix of this 'BufferRange' in any+-- way it desires. If the 'BuildStep' is done, the 'BufferRange' is full, or a+-- long sequence of bytes should be inserted directly, then the 'BuildStep'+-- signals this to its caller using a 'BuildSignal'.+--+-- We achieve (2) by requiring that every 'Builder' is implemented by a+-- 'BuildStep' that takes a continuation 'BuildStep', which it calls with the+-- updated 'BufferRange' after it is done. Therefore, only two pointers have+-- to be passed in a function call to implement concatenation of 'Builder's.+-- Moreover, many 'Builder's are completely inlined, which enables the compiler+-- to sequence them without a function call and with no boxing at all.+--+-- This design gives the implementation of a 'Builder' full access to the 'IO'+-- monad. Therefore, utmost care has to be taken to not overwrite anything+-- outside the given 'BufferRange's. Moreover, further care has to be taken to+-- ensure that 'Builder's and 'Put's are referentially transparent. See the+-- comments of the 'builder' and 'put' functions for further information.+-- Note that there are /no safety belts/ at all, when implementing a 'Builder'+-- using an 'IO' action: you are writing code that might enable the next+-- buffer-overflow attack on a Haskell server!+--+module Data.ByteString.Builder.Internal (++  -- * Build signals and steps+    BufferRange(..)+  , LazyByteStringC++  , BuildSignal(..)+  , BuildStep++  , done+  , bufferFull+  , insertChunks++  , fillWithBuildStep++  -- * The Builder monoid+  , Builder+  , builder+  , runBuilder+  , runBuilderWith++  -- ** Primitive combinators+  , empty+  , append+  , flush+  , ensureFree++  , byteStringCopy+  , byteStringInsert+  , byteStringThreshold++  , lazyByteStringCopy+  , lazyByteStringInsert+  , lazyByteStringThreshold++  , lazyByteStringC++  , maximalCopySize+  , byteString+  , lazyByteString++  -- ** Execution strategies+  , toLazyByteStringWith+  , AllocationStrategy+  , safeStrategy+  , untrimmedStrategy+  , L.smallChunkSize+  , L.defaultChunkSize++  -- * The Put monad+  , Put+  , put+  , runPut+  , hPut++  -- ** Streams of chunks interleaved with IO+  , ChunkIOStream(..)+  , buildStepToCIOS+  , ciosToLazyByteString++  -- ** Conversion to and from Builders+  , putBuilder+  , fromPut++  -- ** Lifting IO actions+  -- , putLiftIO++) where++import Control.Applicative (Applicative(..), (<$>))++import Data.Monoid+import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++#if __GLASGOW_HASKELL__ >= 611+import GHC.IO.Buffer (Buffer(..), newByteBuffer)+import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer)+import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)+import System.IO (hFlush, BufferMode(..))+import Data.IORef+#else+import qualified Data.ByteString.Lazy as L+#endif+import System.IO (Handle)++#if MIN_VERSION_base(4,4,0)+import Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import System.IO.Unsafe (unsafePerformIO)+#else+import Foreign+#endif+++type LazyByteStringC = L.ByteString -> L.ByteString++-- | A range of bytes in a buffer represented by the pointer to the first byte+-- of the range and the pointer to the first byte /after/ the range.+data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8)  -- First byte of range+                               {-# UNPACK #-} !(Ptr Word8)  -- First byte /after/ range+++------------------------------------------------------------------------------+-- Build signals+------------------------------------------------------------------------------++-- | 'BuildStep's may assume that they are called at most once. However,+-- they must not execute any function that may rise an async. exception,+-- as this would invalidate the code of 'hPut' below.+type BuildStep a = BufferRange -> IO (BuildSignal a)++-- | 'BuildSignal's abstract signals to the caller of a 'BuildStep'. There are+-- exactly three signals: 'done', 'bufferFull', and 'insertChunks'.+data BuildSignal a =+    Done {-# UNPACK #-} !(Ptr Word8) a+  | BufferFull+      {-# UNPACK #-} !Int+      {-# UNPACK #-} !(Ptr Word8)+                     !(BuildStep a)+  | InsertChunks+      {-# UNPACK #-} !(Ptr Word8)+      {-# UNPACK #-} !Int64                   -- size of bytes in continuation+                      LazyByteStringC+                     !(BuildStep a)++-- | Signal that the current 'BuildStep' is done and has computed a value.+{-# INLINE done #-}+done :: Ptr Word8      -- ^ Next free byte in current 'BufferRange'+     -> a              -- ^ Computed value+     -> BuildSignal a+done = Done++-- | Signal that the current buffer is full.+{-# INLINE bufferFull #-}+bufferFull :: Int+           -- ^ Minimal size of next 'BufferRange'.+           -> Ptr Word8+           -- ^ Next free byte in current 'BufferRange'.+           -> BuildStep a+           -- ^ 'BuildStep' to run on the next 'BufferRange'. This 'BuildStep'+           -- may assume that it is called with a 'BufferRange' of at least the+           -- required minimal size; i.e., the caller of this 'BuildStep' must+           -- guarantee this.+           -> BuildSignal a+bufferFull = BufferFull++-- TODO: Decide whether we should inline the bytestring constructor.+-- Therefore, making builders independent of strict bytestrings.++-- | Signal that several chunks should be inserted directly.+{-# INLINE insertChunks #-}+insertChunks :: Ptr Word8+            -- ^ Next free byte in current 'BufferRange'+            -> Int64+            -- ^ Number of bytes in 'L.ByteString' continuation.+            -> (L.ByteString -> L.ByteString)+            -- ^ Chunks to insert.+            -> BuildStep a+            -- ^ 'BuildStep' to run on next 'BufferRange'+            -> BuildSignal a+insertChunks = InsertChunks++-- | Fill a 'BufferRange' using a 'BuildStep'.+{-# INLINE fillWithBuildStep #-}+fillWithBuildStep+    :: BuildStep a+    -- ^ Build step to use for filling the 'BufferRange'.+    -> (Ptr Word8 -> a -> IO b)+    -- ^ Handling the 'done' signal+    -> (Ptr Word8 -> Int -> BuildStep a -> IO b)+    -- ^ Handling the 'bufferFull' signal+    -> (Ptr Word8 -> Int64 -> LazyByteStringC -> BuildStep a -> IO b)+    -- ^ Handling the 'insertChunks' signal+    -> BufferRange+    -- ^ Buffer range to fill.+    -> IO b+    -- ^ Value computed by filling this 'BufferRange'.+fillWithBuildStep step fDone fFull fChunk !br = do+    signal <- step br+    case signal of+        Done op x                         -> fDone op x+        BufferFull minSize op nextStep    -> fFull op minSize nextStep+        InsertChunks op len lbsC nextStep -> fChunk op len lbsC nextStep++++------------------------------------------------------------------------------+-- The 'Builder' monoid+------------------------------------------------------------------------------++-- | 'Builder's denote sequences of bytes.+-- They are 'Monoid's where+--   'mempty' is the zero-length sequence and+--   'mappend' is concatenation, which runs in /O(1)/.+newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)++-- | Construct a 'Builder'. In contrast to 'BuildStep's, 'Builder's are+-- referentially transparent.+{-# INLINE builder #-}+builder :: (forall r. BuildStep r -> BuildStep r)+        -- ^ A function that fills a 'BufferRange', calls the continuation with+        -- the updated 'BufferRange' once its done, and signals its caller how+        -- to proceed using 'done', 'bufferFull', or 'insertChunk'.+        --+        -- This function must be referentially transparent; i.e., calling it+        -- multiple times must result in the same sequence of bytes being+        -- written. If you need mutable state, then you must allocate it newly+        -- upon each call of this function. Moroever, this function must call+        -- the continuation once its done. Otherwise, concatenation of+        -- 'Builder's does not work. Finally, this function must write to all+        -- bytes that it claims it has written. Otherwise, the resulting+        -- 'Builder' is not guaranteed to be referentially transparent and+        -- sensitive data might leak.+        -> Builder+builder = Builder++-- | Run a 'Builder'.+{-# INLINE runBuilder #-}+runBuilder :: Builder      -- ^ 'Builder' to run+           -> BuildStep () -- ^ 'BuildStep' that writes the byte stream of this+                           -- 'Builder' and signals 'done' upon completion.+runBuilder (Builder b) = b $ \(BufferRange op _) -> return $ done op ()++-- | Run a 'Builder'.+{-# INLINE runBuilderWith #-}+runBuilderWith :: Builder      -- ^ 'Builder' to run+               -> BuildStep a -- ^ Continuation 'BuildStep'+               -> BuildStep a+runBuilderWith (Builder b) = b++-- | The 'Builder' denoting a zero-length sequence of bytes. This function is+-- only exported for use in rewriting rules. Use 'mempty' otherwise.+{-# INLINE[1] empty #-}+empty :: Builder+empty = Builder id++-- | Concatenate two 'Builder's. This function is only exported for use in rewriting+-- rules. Use 'mappend' otherwise.+{-# INLINE[1] append #-}+append :: Builder -> Builder -> Builder+append (Builder b1) (Builder b2) = Builder $ b1 . b2++instance Monoid Builder where+  {-# INLINE mempty #-}+  mempty = empty+  {-# INLINE mappend #-}+  mappend = append+  {-# INLINE mconcat #-}+  mconcat = foldr mappend mempty++instance Show Builder where+  show = show . showBuilder++{-# NOINLINE showBuilder #-} -- ensure code is shared+showBuilder :: Builder -> L.ByteString+showBuilder = toLazyByteStringWith+    (safeStrategy L.smallChunkSize L.smallChunkSize) L.Empty+++-- | Flush the current buffer. This introduces a chunk boundary.+--+{-# INLINE flush #-}+flush :: Builder+flush = builder step+  where+    step k !(BufferRange op _) = return $ insertChunks op 0 id k+++------------------------------------------------------------------------------+-- Put+------------------------------------------------------------------------------++-- | A 'Put' action denotes a computation of a value that writes a stream of+-- bytes as a side-effect. 'Put's are strict in their side-effect; i.e., the+-- stream of bytes will always be written before the computed value is+-- returned.+--+-- 'Put's are a generalization of 'Builder's. They are used when values need to+-- be returned during the computation of a stream of bytes. For example, when+-- performing a block-based encoding of 'S.ByteString's like Base64 encoding,+-- there might be a left-over partial block. Using the 'Put' monad, this+-- partial block can be returned after the complete blocks have been encoded.+-- Then, in a later step when more input is known, this partial block can be+-- completed and also encoded.+--+-- @Put ()@ actions are isomorphic to 'Builder's. The functions 'putBuilder'+-- and 'fromPut' convert between these two types. Where possible, you should+-- use 'Builder's, as they are slightly cheaper than 'Put's because they do not+-- carry a computed value.+newtype Put a = Put { unPut :: forall r. (a -> BuildStep r) -> BuildStep r }++-- | Construct a 'Put' action. In contrast to 'BuildStep's, 'Put's are+-- referentially transparent in the sense that sequencing the same 'Put'+-- multiple times yields every time the same value with the same side-effect.+{-# INLINE put #-}+put :: (forall r. (a -> BuildStep r) -> BuildStep r)+       -- ^ A function that fills a 'BufferRange', calls the continuation with+       -- the updated 'BufferRange' and its computed value once its done, and+       -- signals its caller how to proceed using 'done', 'bufferFull', or+       -- 'insertChunk'.+       --+       -- This function must be referentially transparent; i.e., calling it+       -- multiple times must result in the same sequence of bytes being+       -- written and the same value being computed. If you need mutable state,+       -- then you must allocate it newly upon each call of this function.+       -- Moroever, this function must call the continuation once its done.+       -- Otherwise, monadic sequencing of 'Put's does not work. Finally, this+       -- function must write to all bytes that it claims it has written.+       -- Otherwise, the resulting 'Put' is not guaranteed to be referentially+       -- transparent and sensitive data might leak.+       -> Put a+put = Put++-- | Run a 'Put'.+{-# INLINE runPut #-}+runPut :: Put a       -- ^ Put to run+       -> BuildStep a -- ^ 'BuildStep' that first writes the byte stream of+                      -- this 'Put' and then yields the computed value using+                      -- the 'done' signal.+runPut (Put p) = p $ \x (BufferRange op _) -> return $ Done op x++instance Functor Put where+  fmap f p = Put $ \k -> unPut p (\x -> k (f x))+  {-# INLINE fmap #-}++instance Applicative Put where+  {-# INLINE pure #-}+  pure x = Put $ \k -> k x+  {-# INLINE (<*>) #-}+  Put f <*> Put a = Put $ \k -> f (\f' -> a (\a' -> k (f' a')))+#if MIN_VERSION_base(4,2,0)+  {-# INLINE (<*) #-}+  Put a <* Put b = Put $ \k -> a (\a' -> b (\_ -> k a'))+  {-# INLINE (*>) #-}+  Put a *> Put b = Put $ \k -> a (\_ -> b k)+#endif++instance Monad Put where+  {-# INLINE return #-}+  return x = Put $ \k -> k x+  {-# INLINE (>>=) #-}+  Put m >>= f = Put $ \k -> m (\m' -> unPut (f m') k)+  {-# INLINE (>>) #-}+  Put m >> Put n = Put $ \k -> m (\_ -> n k)+++-- Conversion between Put and Builder+-------------------------------------++-- | Run a 'Builder' as a side-effect of a @Put ()@ action.+{-# INLINE putBuilder #-}+putBuilder :: Builder -> Put ()+putBuilder (Builder b) = Put $ \k -> b (k ())++-- | Convert a @Put ()@ action to a 'Builder'.+{-# INLINE fromPut #-}+fromPut :: Put () -> Builder+fromPut (Put p) = Builder $ \k -> p (\_ -> k)+++-- Lifting IO actions+---------------------++{-+-- | Lift an 'IO' action to a 'Put' action.+{-# INLINE putLiftIO #-}+putLiftIO :: IO a -> Put a+putLiftIO io = put $ \k br -> io >>= (`k` br)+-}+++------------------------------------------------------------------------------+-- Executing a Put directly on a buffered Handle+------------------------------------------------------------------------------++-- | Run a 'Put' action redirecting the produced output to a 'Handle'.+--+-- The output is buffered using the 'Handle's associated buffer. If this+-- buffer is too small to execute one step of the 'Put' action, then+-- it is replaced with a large enough buffer.+hPut :: forall a. Handle -> Put a -> IO a+#if __GLASGOW_HASKELL__ >= 611+hPut h p = do+    fillHandle 1 (runPut p)+  where+    fillHandle :: Int -> BuildStep a -> IO a+    fillHandle !minFree step = do+        next <- wantWritableHandle "hPut" h fillHandle_+        next+      where+        -- | We need to return an inner IO action that is executed outside+        -- the lock taken on the Handle for two reasons:+        --+        --   1. GHC.IO.Handle.Internals mentions in "Note [async]" that+        --      we should never do any side-effecting operations before+        --      an interruptible operation that may raise an async. exception+        --      as long as we are inside 'wantWritableHandle' and the like.+        --      We possibly run the interuptible 'flushWriteBuffer' right at+        --      the start of 'fillHandle', hence entering it a second time is+        --      not safe, as it could lead to a 'BuildStep' being run twice.+        --+        --   2. We use the 'S.hPut' function to also write to the handle.+        --      This function tries to take the same lock taken by+        --      'wantWritableHandle'. Therefore, we cannot call 'S.hPut'+        --      inside 'wantWritableHandle'.+        --+        fillHandle_ :: Handle__ -> IO (IO a)+        fillHandle_ h_ = do+            makeSpace  =<< readIORef refBuf+            fillBuffer =<< readIORef refBuf+          where+            refBuf        = haByteBuffer h_+            freeSpace buf = bufSize buf - bufR buf++            makeSpace buf+              | bufSize buf < minFree = do+                  flushWriteBuffer h_+                  s <- bufState <$> readIORef refBuf+                  newByteBuffer minFree s >>= writeIORef refBuf++              | freeSpace buf < minFree = flushWriteBuffer h_+              | otherwise               =+#if __GLASGOW_HASKELL__ >= 613+                                          return ()+#else+                                          -- required for ghc-6.12+                                          flushWriteBuffer h_+#endif++            fillBuffer buf+              | freeSpace buf < minFree =+                  error $ unlines+                    [ "Data.ByteString.Builder.Internal.hPut: internal error."+                    , "  Not enough space after flush."+                    , "    required: " ++ show minFree+                    , "    free: "     ++ show (freeSpace buf)+                    ]+              | otherwise = do+                  let !br = BufferRange op (pBuf `plusPtr` bufSize buf)+                  res <- fillWithBuildStep step doneH fullH insertChunksH br+                  touchForeignPtr fpBuf+                  return res+              where+                fpBuf = bufRaw buf+                pBuf  = unsafeForeignPtrToPtr fpBuf+                op    = pBuf `plusPtr` bufR buf++                {-# INLINE updateBufR #-}+                updateBufR op' = do+                    let !off' = op' `minusPtr` pBuf+                        !buf' = buf {bufR = off'}+                    writeIORef refBuf buf'++                doneH op' x = do+                    updateBufR op'+                    -- We must flush if this Handle is set to NoBuffering.+                    -- If it is set to LineBuffering, be conservative and+                    -- flush anyway (we didn't check for newlines in the data).+                    -- Flushing must happen outside this 'wantWriteableHandle'+                    -- due to the possible async. exception.+                    case haBufferMode h_ of+                        BlockBuffering _      -> return $ return x+                        _line_or_no_buffering -> return $ hFlush h >> return x++                fullH op' minSize nextStep = do+                    updateBufR op'+                    return $ fillHandle minSize nextStep+                    -- 'fillHandle' will flush the buffer (provided there is+                    -- really less than 'minSize' space left) before executing+                    -- the 'nextStep'.++                insertChunksH op' _ lbsC nextStep = do+                    updateBufR op'+                    return $ do+                        L.foldrChunks (\c rest -> S.hPut h c >> rest) (return ())+                                      (lbsC L.Empty)+                        fillHandle 1 nextStep+#else+hPut h p =+    go =<< buildStepToCIOS strategy (return . Finished) (runPut p)+  where+    go (Finished k)       = return k+    go (Yield1 bs io)     = S.hPut h bs >> io >>= go+    go (YieldC _ lbsC io) = L.hPut h (lbsC L.Empty) >> io >>= go+    strategy = untrimmedStrategy L.smallChunkSize L.defaultChunkSize+#endif++------------------------------------------------------------------------------+-- ByteString insertion / controlling chunk boundaries+------------------------------------------------------------------------------++-- Raw memory+-------------++-- | Ensure that there are at least 'n' free bytes for the following 'Builder'.+{-# INLINE ensureFree #-}+ensureFree :: Int -> Builder+ensureFree minFree =+    builder step+  where+    step k br@(BufferRange op ope)+      | ope `minusPtr` op < minFree = return $ bufferFull minFree op k+      | otherwise                   = k br++-- | Copy the bytes from a 'BufferRange' into the output stream.+{-# INLINE bytesCopyStep #-}+bytesCopyStep :: BufferRange  -- ^ Input 'BufferRange'.+              -> BuildStep a -> BuildStep a+bytesCopyStep !(BufferRange ip0 ipe) k =+    go ip0+  where+    go !ip !(BufferRange op ope)+      | inpRemaining <= outRemaining = do+          copyBytes op ip inpRemaining+          let !br' = BufferRange (op `plusPtr` inpRemaining) ope+          k br'+      | otherwise = do+          copyBytes op ip outRemaining+          let !ip' = ip `plusPtr` outRemaining+          return $ bufferFull 1 ope (go ip')+      where+        outRemaining = ope `minusPtr` op+        inpRemaining = ipe `minusPtr` ip++++-- Strict ByteStrings+------------------------------------------------------------------------------+++-- | Construct a 'Builder' that copies the strict 'S.ByteString's, if it is+-- smaller than the treshold, and inserts it directly otherwise.+--+-- For example, @byteStringThreshold 1024@ copies strict 'S.ByteString's whose size+-- is less or equal to 1kb, and inserts them directly otherwise. This implies+-- that the average chunk-size of the generated lazy 'L.ByteString' may be as+-- low as 513 bytes, as there could always be just a single byte between the+-- directly inserted 1025 byte, strict 'S.ByteString's.+--+{-# INLINE byteStringThreshold #-}+byteStringThreshold :: Int -> S.ByteString -> Builder+byteStringThreshold maxCopySize =+    \bs -> builder $ step bs+  where+    step !bs@(S.PS _ _ len) !k br@(BufferRange !op _)+      | len <= maxCopySize = byteStringCopyStep bs k br+      | otherwise          =+          return $! insertChunks op (fromIntegral len) (L.chunk bs) k++-- | Construct a 'Builder' that copies the strict 'S.ByteString'.+--+-- Use this function to create 'Builder's from smallish (@<= 4kb@)+-- 'S.ByteString's or if you need to guarantee that the 'S.ByteString' is not+-- shared with the chunks generated by the 'Builder'.+--+{-# INLINE byteStringCopy #-}+byteStringCopy :: S.ByteString -> Builder+byteStringCopy = \bs -> builder $ byteStringCopyStep bs++{-# INLINE byteStringCopyStep #-}+byteStringCopyStep :: S.ByteString -> BuildStep a -> BuildStep a+byteStringCopyStep (S.PS ifp ioff isize) !k0 =+    bytesCopyStep (BufferRange ip ipe) k+  where+    ip   = unsafeForeignPtrToPtr ifp `plusPtr` ioff+    ipe  = ip `plusPtr` isize+    k br = do touchForeignPtr ifp  -- input consumed: OK to release here+              k0 br++-- | Construct a 'Builder' that always inserts the strict 'S.ByteString'+-- directly as a chunk.+--+-- This implies flushing the output buffer, even if it contains just+-- a single byte. You should therefore use 'byteStringInsert' only for large+-- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too+-- fragmented to be processed efficiently afterwards.+--+{-# INLINE byteStringInsert #-}+byteStringInsert :: S.ByteString -> Builder+byteStringInsert =+    \bs -> builder $ step bs+  where+    step !bs k !br@(BufferRange op _)+      | S.null bs = k br+      | otherwise =+          return $ insertChunks op (fromIntegral $ S.length bs) (L.Chunk bs) k+++-- Lazy bytestrings+------------------------------------------------------------------------------++-- | Construct a 'Builder' that uses the thresholding strategy of 'byteStringThreshold'+-- for each chunk of the lazy 'L.ByteString'.+--+{-# INLINE lazyByteStringThreshold #-}+lazyByteStringThreshold :: Int -> L.ByteString -> Builder+lazyByteStringThreshold maxCopySize =+    L.foldrChunks (\bs b -> byteStringThreshold maxCopySize bs `mappend` b) mempty+    -- TODO: We could do better here. Currently, Large, Small, Large, leads to+    -- an unnecessary copy of the 'Small' chunk.++-- | Construct a 'Builder' that copies the lazy 'L.ByteString'.+--+{-# INLINE lazyByteStringCopy #-}+lazyByteStringCopy :: L.ByteString -> Builder+lazyByteStringCopy =+    L.foldrChunks (\bs b -> byteStringCopy bs `mappend` b) mempty+++-- | Construct a 'Builder' that inserts all chunks of the lazy 'L.ByteString'+-- directly.+--+{-# INLINE lazyByteStringInsert #-}+lazyByteStringInsert :: L.ByteString -> Builder+lazyByteStringInsert =+    \lbs -> builder $ step lbs+  where+    step L.Empty k br                 = k br+    step lbs     k (BufferRange op _) = case go 0 id lbs of+        (n, lbsC) -> return $ insertChunks op n lbsC k++    go !n lbsC L.Empty          = (n, lbsC)+    go !n lbsC (L.Chunk bs lbs) =+        go (n + fromIntegral (S.length bs)) (lbsC . L.Chunk bs) lbs+++-- | Create a 'Builder' denoting the same sequence of bytes as a strict+-- 'S.ByteString'.+-- The 'Builder' inserts large 'S.ByteString's directly, but copies small ones+-- to ensure that the generated chunks are large on average.+--+{-# INLINE byteString #-}+byteString :: S.ByteString -> Builder+byteString = byteStringThreshold maximalCopySize++-- | Create a 'Builder' denoting the same sequence of bytes as a lazy+-- 'S.ByteString'.+-- The 'Builder' inserts large chunks of the lazy 'L.ByteString' directly,+-- but copies small ones to ensure that the generated chunks are large on+-- average.+--+{-# INLINE lazyByteString #-}+lazyByteString :: L.ByteString -> Builder+lazyByteString = lazyByteStringThreshold maximalCopySize+-- FIXME: also insert the small chunk for [large,small,large] directly.+-- Perhaps it makes even sense to concatenate the small chunks in+-- [large,small,small,small,large] and insert them directly afterwards to avoid+-- unnecessary buffer spilling. Hmm, but that uncontrollably increases latency+-- => no good!++-- | The maximal size of a 'S.ByteString' that is copied.+-- @2 * 'L.smallChunkSize'@ to guarantee that on average a chunk is of+-- 'L.smallChunkSize'.+maximalCopySize :: Int+maximalCopySize = 2 * L.smallChunkSize++-- LazyByteStringC: difference lists of lazy bytestrings+--------------------------------------------------------++-- | Insert a 'LazyByteStringC' of the given size directly.+{-# INLINE lazyByteStringC #-}+lazyByteStringC :: Int64 -> LazyByteStringC -> Builder+lazyByteStringC n lbsC =+    builder $ \k (BufferRange op _) -> return $ insertChunks op n lbsC k++------------------------------------------------------------------------------+-- Builder execution+------------------------------------------------------------------------------++-- | A buffer allocation strategy for executing 'Builder's.++-- The strategy+--+-- > 'AllocationStrategy' firstBufSize bufSize trim+--+-- states that the first buffer is of size @firstBufSize@, all following buffers+-- are of size @bufSize@, and a buffer of size @n@ filled with @k@ bytes should+-- be trimmed iff @trim k n@ is 'True'.+data AllocationStrategy = AllocationStrategy+         {-# UNPACK #-} !Int  -- size of first buffer+         {-# UNPACK #-} !Int  -- size of successive buffers+         (Int -> Int -> Bool) -- trim++-- | Sanitize a buffer size; i.e., make it at least the size of a 'Int'.+{-# INLINE sanitize #-}+sanitize :: Int -> Int+sanitize = max (sizeOf (undefined :: Int))++-- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- discarded right after they are generated. For example, if you just generate+-- them to write them to a network socket.+{-# INLINE untrimmedStrategy #-}+untrimmedStrategy :: Int -- ^ Size of the first buffer+                  -> Int -- ^ Size of successive buffers+                  -> AllocationStrategy+                  -- ^ An allocation strategy that does not trim any of the+                  -- filled buffers before converting it to a chunk.+untrimmedStrategy firstSize bufSize =+    AllocationStrategy (sanitize firstSize) (sanitize bufSize) (\_ _ -> False)+++-- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- likely to survive one garbage collection. This strategy trims buffers+-- that are filled less than half in order to avoid spilling too much memory.+{-# INLINE safeStrategy #-}+safeStrategy :: Int  -- ^ Size of first buffer+             -> Int  -- ^ Size of successive buffers+             -> AllocationStrategy+             -- ^ An allocation strategy that guarantees that at least half+             -- of the allocated memory is used for live data+safeStrategy firstSize bufSize =+    AllocationStrategy (sanitize firstSize) (sanitize bufSize)+                       (\used size -> 2*used < size)++-- | Execute a 'Builder' with custom execution parameters.+--+-- This function is forced to be inlined to allow fusing with the allocation+-- strategy despite its rather heavy code-size. We therefore recommend+-- that you introduce a top-level function once you have fixed your strategy.+-- This avoids unnecessary code duplication.+-- For example, the default 'Builder' execution function 'toLazyByteString' is+-- defined as follows.+--+-- @+-- {-# NOINLINE toLazyByteString #-}+-- toLazyByteString =+--   toLazyByteStringWith ('safeStrategy' 'L.smallChunkSize' 'L.defaultChunkSize') empty+-- @+--+-- where @empty@ is the zero-length lazy 'L.ByteString'.+--+-- In most cases, the parameters used by 'toLazyByteString' give good+-- performance. A sub-performing case of 'toLazyByteString' is executing short+-- (<128 bytes) 'Builder's. In this case, the allocation overhead for the first+-- 4kb buffer and the trimming cost dominate the cost of executing the+-- 'Builder'. You can avoid this problem using+--+-- >toLazyByteStringWith (safeStrategy 128 smallChunkSize) empty+--+-- This reduces the allocation and trimming overhead, as all generated+-- 'L.ByteString's fit into the first buffer and there is no trimming+-- required, if more than 64 bytes are written.+--+{-# INLINE toLazyByteStringWith #-}+toLazyByteStringWith+    :: AllocationStrategy+       -- ^ Buffer allocation strategy to use+    -> L.ByteString+       -- ^ Lazy 'L.ByteString' to use as the tail of the generated lazy+       -- 'L.ByteString'+    -> Builder+       -- ^ Builder to execute+    -> L.ByteString+       -- ^ Resulting lazy 'L.ByteString'+toLazyByteStringWith strategy k b =+    ciosToLazyByteString k $ unsafePerformIO $+        buildStepToCIOS strategy (return . Finished) (runBuilder b)++-- | A stream of non-empty chunks interleaved with 'IO'.+data ChunkIOStream a =+       Finished a+     | Yield1 {-# UNPACK #-} !S.ByteString (IO (ChunkIOStream a))+     | YieldC {-# UNPACK #-} !Int64 LazyByteStringC (IO (ChunkIOStream a))++{-# INLINE ciosToLazyByteString #-}+ciosToLazyByteString :: L.ByteString -> ChunkIOStream () -> L.ByteString+ciosToLazyByteString k = go+  where+    go (Finished _)       = k+    go (Yield1 bs io)     = L.Chunk bs $ unsafePerformIO (go <$> io)+    go (YieldC _ lbsC io) = lbsC $ unsafePerformIO (go <$> io)++{-# INLINE buildStepToCIOS #-}+buildStepToCIOS+    :: AllocationStrategy          -- ^ Buffer allocation strategy to use+    -> (a -> IO (ChunkIOStream b)) -- ^ Continuation stream constructor.+    -> BuildStep a                 -- ^ 'Put' to execute+    -> IO (ChunkIOStream b)+buildStepToCIOS (AllocationStrategy firstSize bufSize trim) k =+    \step -> fillNew step firstSize+  where+    fillNew !step0 !size = do+        S.mallocByteString size >>= fill step0+      where+        fill !step !fpbuf = do+            res <- fillWithBuildStep step doneH fullH insertChunksH br+            touchForeignPtr fpbuf+            return res+          where+            op = unsafeForeignPtrToPtr fpbuf -- safe due to mkCIOS+            pe = op `plusPtr` size+            br = BufferRange op pe++            doneH op' x = wrapChunk op' (const $ k x)++            fullH op' minSize nextStep =+                wrapChunk op' (const $ fillNew nextStep (max minSize bufSize))++            insertChunksH op' n lbsC nextStep =+                wrapChunk op' $ \isEmpty -> return $ YieldC n lbsC $+                    -- Checking for empty case avoids allocating 'n-1' empty+                    -- buffers for 'n' insertChunksH right after each other.+                    if isEmpty+                      then fill nextStep fpbuf+                      else fillNew nextStep bufSize++            -- Yield a chunk, trimming it if necesary+            {-# INLINE wrapChunk #-}+            wrapChunk !op' mkCIOS+              | pe < op'            = error $+                  "buildStepToCIOS: overwrite by " ++ show (op' `minusPtr` pe) ++ " bytes"+              | chunkSize == 0      = mkCIOS True+              | trim chunkSize size = do+                  bs <- S.create chunkSize $ \pbuf -> copyBytes pbuf op chunkSize+                  return $ Yield1 bs (mkCIOS False)+              | otherwise            =+                  return $ Yield1 (S.PS fpbuf 0 chunkSize) (mkCIOS False)+              where+                chunkSize = op' `minusPtr` op

@@ -0,0 +1,776 @@+{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{- | Copyright : (c) 2010-2011 Simon Meier+                 (c) 2010      Jasper van der Jeugt+License        : BSD3-style (see LICENSE)+Maintainer     : Simon Meier <iridcode@gmail.com>+Portability    : GHC++This module provides 'Builder' /primitives/, which are lower level building+blocks for constructing 'Builder's. You don't need to go down to this level but+it can be slightly faster.++Morally, builder primitives are like functions @a -> Builder@, that is they+take a value and encode it as a sequence of bytes, represented as a 'Builder'.+Of course their implementation is a bit more specialised.++Builder primitives come in two forms: fixed-size and bounded-size.++* /Fixed(-size) primitives/ are builder primitives that always result in a+  sequence of bytes of a fixed length. That is, the length is independent of+  the value that is encoded. An example of a fixed size primitive is the+  big-endian encoding of a 'Word64', which always results in exactly 8 bytes.++* /Bounded(-size) primitives/ are builder primitives that always result in a+  sequence of bytes that is no larger than a predetermined bound. That is, the+  bound is independent of the value that is encoded but the actual length will+  depend on the value. An example for a bounded primitive is the UTF-8 encoding+  of a 'Char', which can be 1,2,3 or 4 bytes long, so the bound is 4 bytes.++Note that fixed primitives can be considered as a special case of bounded+primitives, and we can lift from fixed to bounded.++Because bounded primitives are the more general case, in this documentation we+only refer to fixed size primitives where it matters that the resulting+sequence of bytes is of a fixed length. Otherwise, we just refer to bounded+size primitives.++The purpose of using builder primitives is to improve the performance of+'Builder's. These improvements stem from making the two most common steps+performed by a 'Builder' more efficient. We explain these two steps in turn.++The first most common step is the concatenation of two 'Builder's. Internally,+concatenation corresponds to function composition. (Note that 'Builder's can+be seen as difference-lists of buffer-filling functions; cf. +<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dlist>. )+Function composition is a fast /O(1)/ operation. However, we can use bounded+primitives to remove some of these function compositions altogether, which is+more efficient.++The second most common step performed by a 'Builder' is to fill a buffer using+a bounded primitives, which works as follows. The 'Builder' checks whether+there is enough space left to execute the bounded primitive. If there is, then+the 'Builder' executes the bounded primitive and calls the next 'Builder' with+the updated buffer. Otherwise, the 'Builder' signals its driver that it+requires a new buffer. This buffer must be at least as large as the bound of+the primitive. We can use bounded primitives to reduce the number of+buffer-free checks by fusing the buffer-free checks of consecutive 'Builder's.+We can also use bounded primitives to simplify the control flow for signalling+that a buffer is full by ensuring that we check first that there is enough+space left and only then decide on how to encode a given value.++Let us illustrate these improvements on the CSV-table rendering example from+"Data.ByteString.Builder". Its \"hot code\" is the rendering of a table's+cells, which we implement as follows using only the functions from the+'Builder' API.++@+import "Data.ByteString.Builder" as B++renderCell :: Cell -> Builder+renderCell (StringC cs) = renderString cs+renderCell (IntC i)     = B.intDec i++renderString :: String -> Builder+renderString cs = B.charUtf8 \'\"\' \<\> foldMap escape cs \<\> B.charUtf8 \'\"\'+  where+    escape \'\\\\\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\\\'+    escape \'\\\"\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\"\'+    escape c    = B.charUtf8 c+@++Efficient encoding of 'Int's as decimal numbers is performed by @intDec@.+Optimization potential exists for the escaping of 'String's. The above+implementation has two optimization opportunities. First, the buffer-free+checks of the 'Builder's for escaping double quotes and backslashes can be+fused. Second, the concatenations performed by 'foldMap' can be eliminated.+The following implementation exploits these optimizations.++@+import qualified Data.ByteString.Builder.Prim  as P+import           Data.ByteString.Builder.Prim+                 ( 'condB', 'liftFixedToBounded', ('>*<'), ('>$<') )++renderString :: String -\> Builder+renderString cs =+    B.charUtf8 \'\"\' \<\> E.'encodeListWithB' escape cs \<\> B.charUtf8 \'\"\'+  where+    escape :: E.'BoundedPrim' Char+    escape =+      'condB' (== \'\\\\\') (fixed2 (\'\\\\\', \'\\\\\')) $+      'condB' (== \'\\\"\') (fixed2 (\'\\\\\', \'\\\"\')) $+      E.'charUtf8'+    &#160;+    {&#45;\# INLINE fixed2 \#&#45;}+    fixed2 x = 'liftFixedToBounded' $ const x '>$<' E.'char7' '>*<' E.'char7'+@++The code should be mostly self-explanatory. The slightly awkward syntax is+because the combinators are written such that the size-bound of the resulting+'BoundedPrim' can be computed at compile time. We also explicitly inline the+'fixed2' primitive, which encodes a fixed tuple of characters, to ensure that+the bound computation happens at compile time. When encoding the following list+of 'String's, the optimized implementation of 'renderString' is two times+faster.++@+maxiStrings :: [String]+maxiStrings = take 1000 $ cycle [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]+@++Most of the performance gain stems from using 'primMapListBounded', which+encodes a list of values from left-to-right with a 'BoundedPrim'. It exploits+the 'Builder' internals to avoid unnecessary function compositions (i.e.,+concatenations). In the future, we might expect the compiler to perform the+optimizations implemented in 'primMapListBounded'. However, it seems that the+code is currently to complicated for the compiler to see through. Therefore, we+provide the 'BoundedPrim' escape hatch, which allows data structures to provide+very efficient encoding traversals, like 'primMapListBounded' for lists.++Note that 'BoundedPrim's are a bit verbose, but quite versatile. Here is an+example of a 'BoundedPrim' for combined HTML escaping and UTF-8 encoding. It+exploits that the escaped character with the maximal Unicode codepoint is \'>\'.++@+{&#45;\# INLINE charUtf8HtmlEscaped \#&#45;}+charUtf8HtmlEscaped :: E.BoundedPrim Char+charUtf8HtmlEscaped =+    'condB' (>  \'\>\' ) E.'charUtf8' $+    'condB' (== \'\<\' ) (fixed4 (\'&\',(\'l\',(\'t\',\';\')))) $        -- &lt;+    'condB' (== \'\>\' ) (fixed4 (\'&\',(\'g\',(\'t\',\';\')))) $        -- &gt;+    'condB' (== \'&\' ) (fixed5 (\'&\',(\'a\',(\'m\',(\'p\',\';\'))))) $  -- &amp;+    'condB' (== \'\"\' ) (fixed5 (\'&\',(\'\#\',(\'3\',(\'4\',\';\'))))) $  -- &\#34;+    'condB' (== \'\\\'\') (fixed5 (\'&\',(\'\#\',(\'3\',(\'9\',\';\'))))) $  -- &\#39;+    ('liftFixedToBounded' E.'char7')         -- fallback for 'Char's smaller than \'\>\'+  where+    {&#45;\# INLINE fixed4 \#&#45;}+    fixed4 x = 'liftFixedToBounded' $ const x '>$<'+      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+    &#160;+    {&#45;\# INLINE fixed5 \#&#45;}+    fixed5 x = 'liftFixedToBounded' $ const x '>$<'+      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+@++This module currently does not expose functions that require the special+properties of fixed-size primitives. They are useful for prefixing 'Builder's+with their size or for implementing chunked encodings. We will expose the+corresponding functions in future releases of this library.+-}++++{-+--+--+-- A /bounded primitive/ is a builder primitive that never results in a sequence+-- longer than some fixed number of bytes. This number of bytes must be+-- independent of the value being encoded. Typical examples of bounded+-- primitives are the big-endian encoding of a 'Word64', which results always+-- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always+-- in less or equal to 4 bytes.+--+-- Typically, primitives are implemented efficiently by allocating a buffer (an+-- array of bytes) and repeatedly executing the following two steps: (1)+-- writing to the buffer until it is full and (2) handing over the filled part+-- to the consumer of the encoded value. Step (1) is where bounded primitives+-- are used. We must use a bounded primitive, as we must check that there is+-- enough free space /before/ actually writing to the buffer.+--+-- In term of expressiveness, it would be sufficient to construct all encodings+-- from the single bounded encoding that encodes a 'Word8' as-is. However,+-- this is not sufficient in terms of efficiency. It results in unnecessary+-- buffer-full checks and it complicates the program-flow for writing to the+-- buffer, as buffer-full checks are interleaved with analysing the value to be+-- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a+-- significant effect on overall encoding performance, as encoding primitive+-- Haskell values such as 'Word8's or 'Char's lies at the heart of every+-- encoding implementation.+--+-- The bounded 'Encoding's provided by this module remove this performance+-- problem. Intuitively, they consist of a tuple of the bound on the maximal+-- number of bytes written and the actual implementation of the encoding as a+-- function that modifies a mutable buffer. Hence when executing a bounded+-- 'Encoding', the buffer-full check can be done once before the actual writing+-- to the buffer. The provided 'Encoding's also take care to implement the+-- actual writing to the buffer efficiently. Moreover, combinators are+-- provided to construct new bounded encodings from the provided ones.+--+-- A typical example for using the combinators is a bounded 'Encoding' that+-- combines escaping the ' and \\ characters with UTF-8 encoding. More+-- precisely, the escaping to be done is the one implemented by the following+-- @escape@ function.+--+-- > escape :: Char -> [Char]+-- > escape '\'' = "\\'"+-- > escape '\\' = "\\\\"+-- > escape c    = [c]+--+-- The bounded 'Encoding' that combines this escaping with UTF-8 encoding is+-- the following.+--+-- > import Data.ByteString.Builder.Prim.Utf8 (char)+-- >+-- > {-# INLINE escapeChar #-}+-- > escapeUtf8 :: BoundedPrim Char+-- > escapeUtf8 =+-- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $+-- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $+-- >     char+--+-- The definition of 'escapeUtf8' is more complicated than 'escape', because+-- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in+-- 'escapeChar' compute both the bound on the maximal number of bytes written+-- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required+-- to implement the encoding. Bounded 'Encoding's should always be inlined.+-- Otherwise, the compiler cannot compute the bound on the maximal number of+-- bytes written at compile-time. Without inlinining, it would also fail to+-- optimize the constant encoding of the escape characters in the above+-- example. Functions that execute bounded 'Encoding's also perform+-- suboptimally, if the definition of the bounded 'Encoding' is not inlined.+-- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.+--+-- Currently, the only library that executes bounded 'Encoding's is the+-- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It+-- uses bounded 'Encoding's to implement most of its lazy bytestring builders.+-- Executing a bounded encoding should be done using the corresponding+-- functions in the lazy bytestring builder 'Extras' module.+--+-- TODO: Merge with explanation/example below+--+-- Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by+-- writing a bounded-size sequence of bytes directly to memory. They are+-- lifted to conversions from Haskell values to 'Builder's by wrapping them+-- with a bound-check. The compiler can implement this bound-check very+-- efficiently (i.e, a single comparison of the difference of two pointers to a+-- constant), because the bound of a 'E.Encoding' is always independent of the+-- value being encoded and, in most cases, a literal constant.+--+-- 'E.Encoding's are the primary means for defining conversion functions from+-- primitive Haskell values to 'Builder's. Most 'Builder' constructors+-- provided by this library are implemented that way.+-- 'E.Encoding's are also used to construct conversions that exploit the internal+-- representation of data-structures.+--+-- For example, 'encodeByteStringWith' works directly on the underlying byte+-- array and uses some tricks to reduce the number of variables in its inner+-- loop. Its efficiency is exploited for implementing the @filter@ and @map@+-- functions in "Data.ByteString.Lazy" as+--+-- > import qualified Codec.Bounded.Encoding as E+-- >+-- > filter :: (Word8 -> Bool) -> ByteString -> ByteString+-- > filter p = toLazyByteString . encodeLazyByteStringWithB write+-- >   where+-- >     write = E.encodeIf p E.word8 E.emptyEncoding+-- >+-- > map :: (Word8 -> Word8) -> ByteString -> ByteString+-- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)+--+-- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,+-- these versions use a more efficient inner loop and have the additional+-- advantage that they always result in well-chunked 'L.ByteString's; i.e, they+-- also perform automatic defragmentation.+--+-- We can also use 'E.Encoding's to improve the efficiency of the following+-- 'renderString' function from our UTF-8 CSV table encoding example in+-- "Data.ByteString.Builder".+--+-- > renderString :: String -> Builder+-- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'+-- >   where+-- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'+-- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'+-- >     escape c    = charUtf8 c+--+-- The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes+-- characters and using 'encodeListWith', which implements writing a list of+-- values with a tighter inner loop and no 'mappend'.+--+-- > import Data.ByteString.Builder.Extra     -- assume these+-- > import Data.ByteString.Builder.Prim      -- imports are present+-- >        ( BoundedPrim, encodeIf, (<#>), (#.) )+-- > import Data.ByteString.Builder.Prim.Utf8 (char)+-- >+-- > renderString :: String -> Builder+-- > renderString cs =+-- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'+-- >   where+-- >     escapedUtf8 :: BoundedPrim Char+-- >     escapedUtf8 =+-- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $+-- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $+-- >       char+--+-- This 'Builder' considers a buffer with less than 8 free bytes as full. As+-- all functions are inlined, the compiler is able to optimize the constant+-- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of+-- 'renderString' this implementation is 1.7x faster.+--+-}+{-+Internally, 'Builder's are buffer-fill operations that are+given a continuation buffer-fill operation and a buffer-range to be filled.+A 'Builder' first checks if the buffer-range is large enough. If that's+the case, the 'Builder' writes the sequences of bytes to the buffer and+calls its continuation.  Otherwise, it returns a signal that it requires a+new buffer together with a continuation to be called on this new buffer.+Ignoring the rare case of a full buffer-range, the execution cost of a+'Builder' consists of three parts:++  1. The time taken to read the parameters; i.e., the buffer-fill+     operation to call after the 'Builder' is done and the buffer-range to+     fill.++  2. The time taken to check for the size of the buffer-range.++  3. The time taken for the actual encoding.++We can reduce cost (1) by ensuring that fewer buffer-fill function calls are+required. We can reduce cost (2) by fusing buffer-size checks of sequential+writes. For example, when escaping a 'String' using 'renderString', it would+be sufficient to check before encoding a character that at least 8 bytes are+free. We can reduce cost (3) by implementing better primitive 'Builder's.+For example, 'renderCell' builds an intermediate list containing the decimal+representation of an 'Int'. Implementing a direct decimal encoding of 'Int's+to memory would be more efficient, as it requires fewer buffer-size checks+and less allocation. It is also a planned extension of this library.++The first two cost reductions are supported for user code through functions+in "Data.ByteString.Builder.Extra". There, we continue the above example+and drop the generation time to 0.8ms by implementing 'renderString' more+cleverly. The third reduction requires meddling with the internals of+'Builder's and is not recommended in code outside of this library. However,+patches to this library are very welcome.+-}+module Data.ByteString.Builder.Prim (++  -- * Bounded-size primitives++    BoundedPrim++  -- ** Combinators+  -- | The combinators for 'BoundedPrim's are implemented such that the+  -- size of the resulting 'BoundedPrim' can be computed at compile time.+  , emptyB+  , (>*<)+  , (>$<)+  , eitherB+  , condB++  -- ** Builder construction+  , primBounded+  , primMapListBounded+  , primUnfoldrBounded++  , primMapByteStringBounded+  , primMapLazyByteStringBounded++  -- * Fixed-size primitives+  , FixedPrim++  -- ** Combinators+  -- | The combinators for 'FixedPrim's are implemented such that the 'size'+  -- of the resulting 'FixedPrim' is computed at compile time.+  --+  -- The '(>*<)' and '(>$<)' pairing and mapping operators can be used+  -- with 'FixedPrim'.+  , emptyF+  , liftFixedToBounded++  -- ** Builder construction+  -- | In terms of expressivity, the function 'fixedPrim' would be sufficient+  -- for constructing 'Builder's from 'FixedPrim's. The fused variants of+  -- this function are provided because they allow for more efficient+  -- implementations. Our compilers are just not smart enough yet; and for some+  -- of the employed optimizations (see the code of 'encodeByteStringWithF')+  -- they will very likely never be.+  --+  -- Note that functions marked with \"/Heavy inlining./\" are forced to be+  -- inlined because they must be specialized for concrete encodings,+  -- but are rather heavy in terms of code size. We recommend to define a+  -- top-level function for every concrete instantiation of such a function in+  -- order to share its code. A typical example is the function+  -- 'byteStringHex' from "Data.ByteString.Builder.ASCII", which is+  -- implemented as follows.+  --+  -- @+  -- byteStringHex :: S.ByteString -> Builder+  -- byteStringHex = 'encodeByteStringWithF' 'word8HexFixed'+  -- @+  --+  , primFixed+  , primMapListFixed+  , primUnfoldrFixed++  , primMapByteStringFixed+  , primMapLazyByteStringFixed++  -- * Standard encodings of Haskell values++  , module Data.ByteString.Builder.Prim.Binary++  -- ** Character encodings+  , module Data.ByteString.Builder.Prim.ASCII++  -- *** ISO/IEC 8859-1 (Char8)+  -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.+  -- The /Char8/ encoding implemented here works by truncating the Unicode+  -- codepoint to 8-bits and encoding them as a single byte. For the codepoints+  -- 0-255 this corresponds to the ISO/IEC 8859-1 encoding. Note that the+  -- Char8 encoding is equivalent to the ASCII encoding on the Unicode+  -- codepoints 0-127. Hence, functions such as 'intDec' can also be used for+  -- encoding 'Int's as a decimal number with Char8 encoded characters.+  , char8++  -- *** UTF-8+  -- | The UTF-8 encoding can encode all Unicode codepoints.+  -- It is equivalent to the ASCII encoding on the Unicode codepoints 0-127.+  -- Hence, functions such as 'intDec' can also be used for encoding 'Int's as+  -- a decimal number with UTF-8 encoded characters.+  , charUtf8++{-+  -- * Testing support+  -- | The following four functions are intended for testing use+  -- only. They are /not/ efficient. Basic encodings are efficently executed by+  -- creating 'Builder's from them using the @encodeXXX@ functions explained at+  -- the top of this module.++  , evalF+  , evalB++  , showF+  , showB+-}+  ) where++import           Data.ByteString.Builder.Internal+import           Data.ByteString.Builder.Prim.Internal.UncheckedShifts+import           Data.ByteString.Builder.Prim.Internal.Base16 (lowerTable, encode4_as_8)++import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++import           Data.Monoid+import           Data.List (unfoldr)  -- HADDOCK ONLY+import           Data.Char (chr, ord)+import           Control.Monad ((<=<), unless)++import           Data.ByteString.Builder.Prim.Internal hiding (size, sizeBound)+import qualified Data.ByteString.Builder.Prim.Internal as I (size, sizeBound)+import           Data.ByteString.Builder.Prim.Binary+import           Data.ByteString.Builder.Prim.ASCII++#if MIN_VERSION_base(4,4,0)+import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import           System.IO.Unsafe (unsafePerformIO)+#else+import           Foreign+#endif++------------------------------------------------------------------------------+-- Creating Builders from bounded primitives+------------------------------------------------------------------------------++-- | Encode a value with a 'FixedPrim'.+{-# INLINE primFixed #-}+primFixed :: FixedPrim a -> (a -> Builder)+primFixed = primBounded . toB++-- | Encode a list of values from left-to-right with a 'FixedPrim'.+{-# INLINE primMapListFixed #-}+primMapListFixed :: FixedPrim a -> ([a] -> Builder)+primMapListFixed = primMapListBounded . toB++-- | Encode a list of values represented as an 'unfoldr' with a 'FixedPrim'.+{-# INLINE primUnfoldrFixed #-}+primUnfoldrFixed :: FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder+primUnfoldrFixed = primUnfoldrBounded . toB++-- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from+-- left-to-right with a 'FixedPrim'. This function is quite versatile. For+-- example, we can use it to construct a 'Builder' that maps every byte before+-- copying it to the buffer to be filled.+--+-- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder+-- > mapToBuilder f = encodeByteStringWithF (contramapF f word8)+--+-- We can also use it to hex-encode a strict 'S.ByteString' as shown by the+-- 'byteStringHex' example above.+{-# INLINE primMapByteStringFixed #-}+primMapByteStringFixed :: FixedPrim Word8 -> (S.ByteString -> Builder)+primMapByteStringFixed = primMapByteStringBounded . toB++-- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from+-- left-to-right with a 'FixedPrim'.+{-# INLINE primMapLazyByteStringFixed #-}+primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.ByteString -> Builder)+primMapLazyByteStringFixed = primMapLazyByteStringBounded . toB++-- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build+-- fusion. Its performance relies on hoisting several variables out of the+-- inner loop.  That's not possible when writing 'encodeListWith' as a 'foldr'.+-- If we had stream fusion for lists, then we could fuse 'encodeListWith', as+-- 'encodeWithStream' can keep control over the execution.+++-- | Create a 'Builder' that encodes values with the given 'BoundedPrim'.+--+-- We rewrite consecutive uses of 'primBounded' such that the bound-checks are+-- fused. For example,+--+-- > primBounded (word32 c1) `mappend` primBounded (word32 c2)+--+-- is rewritten such that the resulting 'Builder' checks only once, if ther are+-- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This+-- optimization is not observationally equivalent in a strict sense, as it+-- influences the boundaries of the generated chunks. However, for a user of+-- this library it is observationally equivalent, as chunk boundaries of a lazy+-- 'L.ByteString' can only be observed through the internal interface.+-- Morevoer, we expect that all primitives write much fewer than 4kb (the+-- default short buffer size). Hence, it is safe to ignore the additional+-- memory spilled due to the more agressive buffer wrapping introduced by this+-- optimization.+--+{-# INLINE[1] primBounded #-}+primBounded :: BoundedPrim a -> (a -> Builder)+primBounded w =+    mkBuilder+  where+    bound = I.sizeBound w+    mkBuilder x = builder step+      where+        step k (BufferRange op ope)+          | op `plusPtr` bound <= ope = do+              op' <- runB w x op+              let !br' = BufferRange op' ope+              k br'+          | otherwise = return $ bufferFull bound op (step k)++{-# RULES++"append/primBounded" forall w1 w2 x1 x2.+       append (primBounded w1 x1) (primBounded w2 x2)+     = primBounded (pairB w1 w2) (x1, x2)++"append/primBounded/assoc_r" forall w1 w2 x1 x2 b.+       append (primBounded w1 x1) (append (primBounded w2 x2) b)+     = append (primBounded (pairB w1 w2) (x1, x2)) b++"append/primBounded/assoc_l" forall w1 w2 x1 x2 b.+       append (append b (primBounded w1 x1)) (primBounded w2 x2)+     = append b (primBounded (pairB w1 w2) (x1, x2))+  #-}++-- TODO: The same rules for 'putBuilder (..) >> putBuilder (..)'++-- | Create a 'Builder' that encodes a list of values consecutively using a+-- 'BoundedPrim' for each element. This function is more efficient than the+-- canonical+--+-- > filter p =+-- >  B.toLazyByteString .+-- >  E.encodeLazyByteStringWithF (E.ifF p E.word8) E.emptyF)+-- >+--+-- > mconcat . map (primBounded w)+--+-- or+--+-- > foldMap (primBounded w)+--+-- because it moves several variables out of the inner loop.+{-# INLINE primMapListBounded #-}+primMapListBounded :: BoundedPrim a -> [a] -> Builder+primMapListBounded w =+    makeBuilder+  where+    bound = I.sizeBound w+    makeBuilder xs0 = builder $ step xs0+      where+        step xs1 k !(BufferRange op0 ope0) = go xs1 op0+          where+            go [] !op = do+               let !br' = BufferRange op ope0+               k br'++            go xs@(x':xs') !op+              | op `plusPtr` bound <= ope0 = do+                  !op' <- runB w x' op+                  go xs' op'+             | otherwise = return $ bufferFull bound op (step xs k)++-- TODO: Add 'foldMap/encodeWith' its variants+-- TODO: Ensure rewriting 'primBounded w . f = primBounded (w #. f)'++-- | Create a 'Builder' that encodes a sequence generated from a seed value+-- using a 'BoundedPrim' for each sequence element.+{-# INLINE primUnfoldrBounded #-}+primUnfoldrBounded :: BoundedPrim b -> (a -> Maybe (b, a)) -> a -> Builder+primUnfoldrBounded w =+    makeBuilder+  where+    bound = I.sizeBound w+    makeBuilder f x0 = builder $ step x0+      where+        step x1 !k = fill x1+          where+            fill x !(BufferRange pf0 pe0) = go (f x) pf0+              where+                go !Nothing        !pf = do+                    let !br' = BufferRange pf pe0+                    k br'+                go !(Just (y, x')) !pf+                  | pf `plusPtr` bound <= pe0 = do+                      !pf' <- runB w y pf+                      go (f x') pf'+                  | otherwise = return $ bufferFull bound pf $+                      \(BufferRange pfNew peNew) -> do+                          !pfNew' <- runB w y pfNew+                          fill x' (BufferRange pfNew' peNew)++-- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString'+-- using a 'BoundedPrim'. For example, we can write a 'Builder' that filters+-- a strict 'S.ByteString' as follows.+--+-- > import Data.ByteString.Builder.Primas P (word8, condB, emptyB)+--+-- > filterBS p = P.condB p P.word8 P.emptyB+--+{-# INLINE primMapByteStringBounded #-}+primMapByteStringBounded :: BoundedPrim Word8 -> S.ByteString -> Builder+primMapByteStringBounded w =+    \bs -> builder $ step bs+  where+    bound = I.sizeBound w+    step (S.PS ifp ioff isize) !k =+        goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff)+      where+        !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)+        goBS !ip0 !br@(BufferRange op0 ope)+          | ip0 >= ipe = do+              touchForeignPtr ifp -- input buffer consumed+              k br++          | op0 `plusPtr` bound < ope =+              goPartial (ip0 `plusPtr` min outRemaining inpRemaining)++          | otherwise  = return $ bufferFull bound op0 (goBS ip0)+          where+            outRemaining = (ope `minusPtr` op0) `div` bound+            inpRemaining = ipe `minusPtr` ip0++            goPartial !ipeTmp = go ip0 op0+              where+                go !ip !op+                  | ip < ipeTmp = do+                      x   <- peek ip+                      op' <- runB w x op+                      go (ip `plusPtr` 1) op'+                  | otherwise =+                      goBS ip (BufferRange op ope)++-- | Chunk-wise application of 'primMapByteStringBounded'.+{-# INLINE primMapLazyByteStringBounded #-}+primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.ByteString -> Builder+primMapLazyByteStringBounded w =+    L.foldrChunks (\x b -> primMapByteStringBounded w x `mappend` b) mempty+++------------------------------------------------------------------------------+-- Char8 encoding+------------------------------------------------------------------------------++-- | Char8 encode a 'Char'.+{-# INLINE char8 #-}+char8 :: FixedPrim Char+char8 = (fromIntegral . ord) >$< word8+++------------------------------------------------------------------------------+-- UTF-8 encoding+------------------------------------------------------------------------------++-- | UTF-8 encode a 'Char'.+{-# INLINE charUtf8 #-}+charUtf8 :: BoundedPrim Char+charUtf8 = boundedEncoding 4 (encodeCharUtf8 f1 f2 f3 f4)+  where+    pokeN n io op  = io op >> return (op `plusPtr` n)++    f1 x1          = pokeN 1 $ \op -> do pokeByteOff op 0 x1++    f2 x1 x2       = pokeN 2 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2++    f3 x1 x2 x3    = pokeN 3 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2+                                         pokeByteOff op 2 x3++    f4 x1 x2 x3 x4 = pokeN 4 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2+                                         pokeByteOff op 2 x3+                                         pokeByteOff op 3 x4++-- | Encode a Unicode character to another datatype, using UTF-8. This function+-- acts as an abstract way of encoding characters, as it is unaware of what+-- needs to happen with the resulting bytes: you have to specify functions to+-- deal with those.+--+{-# INLINE encodeCharUtf8 #-}+encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8+               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8+               -> Char                                     -- ^ Input 'Char'+               -> a                                        -- ^ Result+encodeCharUtf8 f1 f2 f3 f4 c = case ord c of+    x | x <= 0x7F -> f1 $ fromIntegral x+      | x <= 0x07FF ->+           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0+               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80+           in f2 x1 x2+      | x <= 0xFFFF ->+           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0+               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x3 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f3 x1 x2 x3+      | otherwise ->+           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0+               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80+               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x4 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f4 x1 x2 x3 x4+++------------------------------------------------------------------------------+-- Testing encodings+------------------------------------------------------------------------------+{-+-- | /For testing use only./ Evaluate a 'FixedPrim' on a given value.+evalF :: FixedPrim a -> a -> [Word8]+evalF fe = S.unpack . S.unsafeCreate (I.size fe) . runF fe++-- | /For testing use only./ Evaluate a 'BoundedPrim' on a given value.+evalB :: BoundedPrim a -> a -> [Word8]+evalB be x = S.unpack $ unsafePerformIO $+    S.createAndTrim (I.sizeBound be) $ \op -> do+        op' <- runB be x op+        return (op' `minusPtr` op)++-- | /For testing use only./ Show the result of a 'FixedPrim' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showF :: FixedPrim a -> a -> String+showF fe = map (chr . fromIntegral) . evalF fe++-- | /For testing use only./ Show the result of a 'BoundedPrim' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showB :: BoundedPrim a -> a -> String+showB be = map (chr . fromIntegral) . evalB be+-}+

@@ -0,0 +1,287 @@+{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}+-- | Copyright   : (c) 2010 Jasper Van der Jeugt+--                 (c) 2010 - 2011 Simon Meier+-- License       : BSD3-style (see LICENSE)+--+-- Maintainer    : Simon Meier <iridcode@gmail.com>+-- Portability   : GHC+--+-- Encodings using ASCII encoded Unicode characters.+--+module Data.ByteString.Builder.Prim.ASCII+    (++     -- *** ASCII+     char7++      -- **** Decimal numbers+      -- | Decimal encoding of numbers using ASCII encoded characters.+    , int8Dec+    , int16Dec+    , int32Dec+    , int64Dec+    , intDec++    , word8Dec+    , word16Dec+    , word32Dec+    , word64Dec+    , wordDec++    {-+    -- These are the functions currently provided by Bryan O'Sullivans+    -- double-conversion library.+    --+    -- , float+    -- , floatWith+    -- , double+    -- , doubleWith+    -}++      -- **** Hexadecimal numbers++      -- | Encoding positive integers as hexadecimal numbers using lower-case+      -- ASCII characters. The shortest possible representation is used. For+      -- example,+      --+      -- > toLazyByteString (primBounded word16Hex 0x0a10) = "a10"+      --+      -- Note that there is no support for using upper-case characters. Please+      -- contact the maintainer if your application cannot work without+      -- hexadecimal encodings that use upper-case characters.+      --+    , word8Hex+    , word16Hex+    , word32Hex+    , word64Hex+    , wordHex++      -- **** Fixed-width hexadecimal numbers+      --+      -- | Encoding the bytes of fixed-width types as hexadecimal+      -- numbers using lower-case ASCII characters. For example,+      --+      -- > toLazyByteString (primFixed word16HexFixed 0x0a10) = "0a10"+      --+    , int8HexFixed+    , int16HexFixed+    , int32HexFixed+    , int64HexFixed+    , word8HexFixed+    , word16HexFixed+    , word32HexFixed+    , word64HexFixed+    , floatHexFixed+    , doubleHexFixed++    ) where++import Data.ByteString.Builder.Prim.Binary+import Data.ByteString.Builder.Prim.Internal+import Data.ByteString.Builder.Prim.Internal.Floating+import Data.ByteString.Builder.Prim.Internal.Base16+import Data.ByteString.Builder.Prim.Internal.UncheckedShifts++import Data.Char (ord)++import Foreign+import Foreign.C.Types++-- | Encode the least 7-bits of a 'Char' using the ASCII encoding.+{-# INLINE char7 #-}+char7 :: FixedPrim Char+char7 = (\c -> fromIntegral $ ord c .&. 0x7f) >$< word8+++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------++-- Signed integers+------------------++foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec+    :: CInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec+    :: CLLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeIntDecimal #-}+encodeIntDecimal :: Integral a => Int -> BoundedPrim a+encodeIntDecimal bound = boundedEncoding bound $ c_int_dec . fromIntegral++-- | Decimal encoding of an 'Int8'.+{-# INLINE int8Dec #-}+int8Dec :: BoundedPrim Int8+int8Dec = encodeIntDecimal 4++-- | Decimal encoding of an 'Int16'.+{-# INLINE int16Dec #-}+int16Dec :: BoundedPrim Int16+int16Dec = encodeIntDecimal 6+++-- | Decimal encoding of an 'Int32'.+{-# INLINE int32Dec #-}+int32Dec :: BoundedPrim Int32+int32Dec = encodeIntDecimal 11++-- | Decimal encoding of an 'Int64'.+{-# INLINE int64Dec #-}+int64Dec :: BoundedPrim Int64+int64Dec = boundedEncoding 20 $ c_long_long_int_dec . fromIntegral++-- | Decimal encoding of an 'Int'.+{-# INLINE intDec #-}+intDec :: BoundedPrim Int+intDec = caseWordSize_32_64+    (fromIntegral >$< int32Dec)+    (fromIntegral >$< int64Dec)+++-- Unsigned integers+--------------------++foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec+    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec+    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeWordDecimal #-}+encodeWordDecimal :: Integral a => Int -> BoundedPrim a+encodeWordDecimal bound = boundedEncoding bound $ c_uint_dec . fromIntegral++-- | Decimal encoding of a 'Word8'.+{-# INLINE word8Dec #-}+word8Dec :: BoundedPrim Word8+word8Dec = encodeWordDecimal 3++-- | Decimal encoding of a 'Word16'.+{-# INLINE word16Dec #-}+word16Dec :: BoundedPrim Word16+word16Dec = encodeWordDecimal 5++-- | Decimal encoding of a 'Word32'.+{-# INLINE word32Dec #-}+word32Dec :: BoundedPrim Word32+word32Dec = encodeWordDecimal 10++-- | Decimal encoding of a 'Word64'.+{-# INLINE word64Dec #-}+word64Dec :: BoundedPrim Word64+word64Dec = boundedEncoding 20 $ c_long_long_uint_dec . fromIntegral++-- | Decimal encoding of a 'Word'.+{-# INLINE wordDec #-}+wordDec :: BoundedPrim Word+wordDec = caseWordSize_32_64+    (fromIntegral >$< word32Dec)+    (fromIntegral >$< word64Dec)++------------------------------------------------------------------------------+-- Hexadecimal Encoding+------------------------------------------------------------------------------++-- without lead+---------------++foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex+    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex+    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeWordHex #-}+encodeWordHex :: forall a. (Storable a, Integral a) => BoundedPrim a+encodeWordHex =+    boundedEncoding (2 * sizeOf (undefined :: a)) $ c_uint_hex  . fromIntegral++-- | Hexadecimal encoding of a 'Word8'.+{-# INLINE word8Hex #-}+word8Hex :: BoundedPrim Word8+word8Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word16'.+{-# INLINE word16Hex #-}+word16Hex :: BoundedPrim Word16+word16Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word32'.+{-# INLINE word32Hex #-}+word32Hex :: BoundedPrim Word32+word32Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word64'.+{-# INLINE word64Hex #-}+word64Hex :: BoundedPrim Word64+word64Hex = boundedEncoding 16 $ c_long_long_uint_hex . fromIntegral++-- | Hexadecimal encoding of a 'Word'.+{-# INLINE wordHex #-}+wordHex :: BoundedPrim Word+wordHex = caseWordSize_32_64+    (fromIntegral >$< word32Hex)+    (fromIntegral >$< word64Hex)+++-- fixed width; leading zeroes+------------------------------++-- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).+{-# INLINE word8HexFixed #-}+word8HexFixed :: FixedPrim Word8+word8HexFixed = fixedEncoding 2 $+    \x op -> poke (castPtr op) =<< encode8_as_16h lowerTable x++-- | Encode a 'Word16' using 4 nibbles.+{-# INLINE word16HexFixed #-}+word16HexFixed :: FixedPrim Word16+word16HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w16` 8, fromIntegral x))+      >$< pairF word8HexFixed word8HexFixed++-- | Encode a 'Word32' using 8 nibbles.+{-# INLINE word32HexFixed #-}+word32HexFixed :: FixedPrim Word32+word32HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w32` 16, fromIntegral x))+      >$< pairF word16HexFixed word16HexFixed+-- | Encode a 'Word64' using 16 nibbles.+{-# INLINE word64HexFixed #-}+word64HexFixed :: FixedPrim Word64+word64HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w64` 32, fromIntegral x))+      >$< pairF word32HexFixed word32HexFixed++-- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).+{-# INLINE int8HexFixed #-}+int8HexFixed :: FixedPrim Int8+int8HexFixed = fromIntegral >$< word8HexFixed++-- | Encode a 'Int16' using 4 nibbles.+{-# INLINE int16HexFixed #-}+int16HexFixed :: FixedPrim Int16+int16HexFixed = fromIntegral >$< word16HexFixed++-- | Encode a 'Int32' using 8 nibbles.+{-# INLINE int32HexFixed #-}+int32HexFixed :: FixedPrim Int32+int32HexFixed = fromIntegral >$< word32HexFixed++-- | Encode a 'Int64' using 16 nibbles.+{-# INLINE int64HexFixed #-}+int64HexFixed :: FixedPrim Int64+int64HexFixed = fromIntegral >$< word64HexFixed++-- | Encode an IEEE 'Float' using 8 nibbles.+{-# INLINE floatHexFixed #-}+floatHexFixed :: FixedPrim Float+floatHexFixed = encodeFloatViaWord32F word32HexFixed++-- | Encode an IEEE 'Double' using 16 nibbles.+{-# INLINE doubleHexFixed #-}+doubleHexFixed :: FixedPrim Double+doubleHexFixed = encodeDoubleViaWord64F word64HexFixed++

@@ -0,0 +1,336 @@+{-# LANGUAGE CPP, BangPatterns #-}+-- | Copyright   : (c) 2010-2011 Simon Meier+-- License       : BSD3-style (see LICENSE)+--+-- Maintainer    : Simon Meier <iridcode@gmail.com>+-- Portability   : GHC+--+module Data.ByteString.Builder.Prim.Binary (++  -- ** Binary encodings+    int8+  , word8++  -- *** Big-endian+  , int16BE+  , int32BE+  , int64BE++  , word16BE+  , word32BE+  , word64BE++  , floatBE+  , doubleBE++  -- *** Little-endian+  , int16LE+  , int32LE+  , int64LE++  , word16LE+  , word32LE+  , word64LE++  , floatLE+  , doubleLE++  -- *** Non-portable, host-dependent+  , intHost+  , int16Host+  , int32Host+  , int64Host++  , wordHost+  , word16Host+  , word32Host+  , word64Host++  , floatHost+  , doubleHost++  ) where++import Data.ByteString.Builder.Prim.Internal+import Data.ByteString.Builder.Prim.Internal.UncheckedShifts+import Data.ByteString.Builder.Prim.Internal.Floating++import Foreign++#include "MachDeps.h"++------------------------------------------------------------------------------+-- Binary encoding+------------------------------------------------------------------------------++-- Word encodings+-----------------++-- | Encoding single unsigned bytes as-is.+--+{-# INLINE word8 #-}+word8 :: FixedPrim Word8+word8 = storableToF++--+-- We rely on the fromIntegral to do the right masking for us.+-- The inlining here is critical, and can be worth 4x performance+--++-- | Encoding 'Word16's in big endian format.+{-# INLINE word16BE #-}+word16BE :: FixedPrim Word16+#ifdef WORD_BIGENDIAN+word16BE = word16Host+#else+word16BE = fixedEncoding 2 $ \w p -> do+    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)+#endif++-- | Encoding 'Word16's in little endian format.+{-# INLINE word16LE #-}+word16LE :: FixedPrim Word16+#ifdef WORD_BIGENDIAN+word16LE = fixedEncoding 2 $ \w p -> do+    poke p               (fromIntegral (w)              :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)+#else+word16LE = word16Host+#endif++-- | Encoding 'Word32's in big endian format.+{-# INLINE word32BE #-}+word32BE :: FixedPrim Word32+#ifdef WORD_BIGENDIAN+word32BE = word32Host+#else+word32BE = fixedEncoding 4 $ \w 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)+#endif++-- | Encoding 'Word32's in little endian format.+{-# INLINE word32LE #-}+word32LE :: FixedPrim Word32+#ifdef WORD_BIGENDIAN+word32LE = fixedEncoding 4 $ \w 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)+#else+word32LE = word32Host+#endif++-- on a little endian machine:+-- word32LE w32 = fixedEncoding 4 (\w p -> poke (castPtr p) w32)++-- | Encoding 'Word64's in big endian format.+{-# INLINE word64BE #-}+word64BE :: FixedPrim Word64+#ifdef WORD_BIGENDIAN+word64BE = word64Host+#else+#if WORD_SIZE_IN_BITS < 64+--+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to+-- Word32, and write that+--+word64BE =+    fixedEncoding 8 $ \w p -> do+        let a = fromIntegral (shiftr_w64 w 32) :: Word32+            b = fromIntegral w                 :: Word32+        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+word64BE = fixedEncoding 8 $ \w 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+#endif++-- | Encoding 'Word64's in little endian format.+{-# INLINE word64LE #-}+word64LE :: FixedPrim Word64+#ifdef WORD_BIGENDIAN+#if WORD_SIZE_IN_BITS < 64+word64LE =+    fixedEncoding 8 $ \w p -> do+        let b = fromIntegral (shiftr_w64 w 32) :: Word32+            a = fromIntegral w                 :: Word32+        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+word64LE = fixedEncoding 8 $ \w 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+#else+word64LE = word64Host+#endif+++-- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,+-- host endian form, for the machine you are on. On a 64 bit machine the 'Word'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+{-# INLINE wordHost #-}+wordHost :: FixedPrim Word+wordHost = storableToF++-- | Encoding 'Word16's in native host order and host endianness.+{-# INLINE word16Host #-}+word16Host :: FixedPrim Word16+word16Host = storableToF++-- | Encoding 'Word32's in native host order and host endianness.+{-# INLINE word32Host #-}+word32Host :: FixedPrim Word32+word32Host = storableToF++-- | Encoding 'Word64's in native host order and host endianness.+{-# INLINE word64Host #-}+word64Host :: FixedPrim Word64+word64Host = storableToF+++------------------------------------------------------------------------------+-- Int encodings+------------------------------------------------------------------------------+--+-- We rely on 'fromIntegral' to do a loss-less conversion to the corresponding+-- 'Word' type+--+------------------------------------------------------------------------------++-- | Encoding single signed bytes as-is.+--+{-# INLINE int8 #-}+int8 :: FixedPrim Int8+int8 = fromIntegral >$< word8++-- | Encoding 'Int16's in big endian format.+{-# INLINE int16BE #-}+int16BE :: FixedPrim Int16+int16BE = fromIntegral >$< word16BE++-- | Encoding 'Int16's in little endian format.+{-# INLINE int16LE #-}+int16LE :: FixedPrim Int16+int16LE = fromIntegral >$< word16LE++-- | Encoding 'Int32's in big endian format.+{-# INLINE int32BE #-}+int32BE :: FixedPrim Int32+int32BE = fromIntegral >$< word32BE++-- | Encoding 'Int32's in little endian format.+{-# INLINE int32LE #-}+int32LE :: FixedPrim Int32+int32LE = fromIntegral >$< word32LE++-- | Encoding 'Int64's in big endian format.+{-# INLINE int64BE #-}+int64BE :: FixedPrim Int64+int64BE = fromIntegral >$< word64BE++-- | Encoding 'Int64's in little endian format.+{-# INLINE int64LE #-}+int64LE :: FixedPrim Int64+int64LE = fromIntegral >$< word64LE+++-- TODO: Ensure that they are safe on architectures where an unaligned write is+-- an error.++-- | Encode a single native machine 'Int'. The 'Int's is encoded in host order,+-- host endian form, for the machine you are on. On a 64 bit machine the 'Int'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or integer sized machines, without+-- conversion.+--+{-# INLINE intHost #-}+intHost :: FixedPrim Int+intHost = storableToF++-- | Encoding 'Int16's in native host order and host endianness.+{-# INLINE int16Host #-}+int16Host :: FixedPrim Int16+int16Host = storableToF++-- | Encoding 'Int32's in native host order and host endianness.+{-# INLINE int32Host #-}+int32Host :: FixedPrim Int32+int32Host = storableToF++-- | Encoding 'Int64's in native host order and host endianness.+{-# INLINE int64Host #-}+int64Host :: FixedPrim Int64+int64Host = storableToF++-- IEEE Floating Point Numbers+------------------------------++-- | Encode a 'Float' in big endian format.+{-# INLINE floatBE #-}+floatBE :: FixedPrim Float+floatBE = encodeFloatViaWord32F word32BE++-- | Encode a 'Float' in little endian format.+{-# INLINE floatLE #-}+floatLE :: FixedPrim Float+floatLE = encodeFloatViaWord32F word32LE++-- | Encode a 'Double' in big endian format.+{-# INLINE doubleBE #-}+doubleBE :: FixedPrim Double+doubleBE = encodeDoubleViaWord64F word64BE++-- | Encode a 'Double' in little endian format.+{-# INLINE doubleLE #-}+doubleLE :: FixedPrim Double+doubleLE = encodeDoubleViaWord64F word64LE+++-- | Encode a 'Float' in native host order and host endianness. Values written+-- this way are not portable to different endian machines, without conversion.+--+{-# INLINE floatHost #-}+floatHost :: FixedPrim Float+floatHost = storableToF++-- | Encode a 'Double' in native host order and host endianness.+{-# INLINE doubleHost #-}+doubleHost :: FixedPrim Double+doubleHost = storableToF++

@@ -0,0 +1,890 @@+{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}+{- | Copyright : (c) 2010-2011 Simon Meier+License        : BSD3-style (see LICENSE)++Maintainer     : Simon Meier <iridcode@gmail.com>+Stability      : experimental+Portability    : GHC++An /encoding/ is a conversion function of Haskell values to sequences of bytes.+A /fixed(-size) encoding/ is an encoding that always results in sequence of bytes+  of a pre-determined, fixed length.+An example for a fixed encoding is the big-endian encoding of a 'Word64',+  which always results in exactly 8 bytes.+A /bounded(-size) encoding/ is an encoding that always results in sequence+  of bytes that is no larger than a pre-determined bound.+An example for a bounded encoding is the UTF-8 encoding of a 'Char',+  which results always in less or equal to 4 bytes.+Note that every fixed encoding is also a bounded encoding.+We explicitly identify fixed encodings because they allow some optimizations+  that are impossible with bounded encodings.+In the following,+  we first motivate the use of bounded encodings+  and then give examples of optimizations+  that are only possible with fixed encodings.++Typicall, encodings are implemented efficiently by allocating a buffer+  (a mutable array of bytes)+  and repeatedly executing the following two steps:+  (1) writing to the buffer until it is full and+  (2) handing over the filled part to the consumer of the encoded value.+Step (1) is where bounded encodings are used.+We must use a bounded encoding,+  as we must check that there is enough free space+  /before/ actually writing to the buffer.++In term of expressivity,+  it would be sufficient to construct all encodings+  from the single fixed encoding that encodes a 'Word8' as-is.+However,+  this is not sufficient in terms of efficiency.+It results in unnecessary buffer-full checks and+  it complicates the program-flow for writing to the buffer,+  as buffer-full checks are interleaved with analyzing the value to be+  encoded (e.g., think about the program-flow for UTF-8 encoding).+This has a significant effect on overall encoding performance,+  as encoding primitive Haskell values such as 'Word8's or 'Char's+  lies at the heart of every encoding implementation.++The 'BoundedPrim's provided by this module remove this performance problem.+Intuitively,+  they consist of a tuple of the bound on the maximal number of bytes written+  and the actual implementation of the encoding as+  a function that modifies a mutable buffer.+Hence when executing a 'BoundedPrim',+ the buffer-full check can be done once before the actual writing to the buffer.+The provided 'BoundedPrim's also take care to implement the+  actual writing to the buffer efficiently.+Moreover, combinators are provided to construct new bounded encodings+  from the provided ones.++++The result of an encoding can be consumed efficiently,+  if it is represented as a sequence of large enough+  /chunks/ of consecutive memory (i.e., C @char@ arrays).+The precise meaning of /large enough/ is application dependent.+Typically, an average chunk size between 4kb and 32kb is suitable+  for writing the result to disk or sending it over the network.+We desire large enough chunk sizes because each chunk boundary+  incurs extra work that we must be able to amortize.+++The need for fixed-size encodings arises when considering+  the efficient implementation of encodings that require the encoding of a+  value to be prefixed with the size of the resulting sequence of bytes.+An efficient implementation avoids unnecessary buffer+We can implement this efficiently as follows.+We first reserve the space for the encoding of the size.+Then, we encode the value.+Finally, we encode the size of the resulting sequence of bytes into+  the reserved space.+For this to work++This works only if the encoding resulting size fits++by first, reserving the space for the encoding+  of the size, then performing the++For efficiency,+  we want to avoid unnecessary copying.+++For example, the HTTP/1.0 requires the size of the body to be given in+  the Content-Length field.++chunked-transfer encoding requires each chunk to+  be prefixed with the hexadecimal encoding of the chunk size.+++-}++{-+--+--+-- A /bounded encoding/ is an encoding that never results in a sequence+-- longer than some fixed number of bytes. This number of bytes must be+-- independent of the value being encoded. Typical examples of bounded+-- encodings are the big-endian encoding of a 'Word64', which results always+-- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always+-- in less or equal to 4 bytes.+--+-- Typically, encodings are implemented efficiently by allocating a buffer (an+-- array of bytes) and repeatedly executing the following two steps: (1)+-- writing to the buffer until it is full and (2) handing over the filled part+-- to the consumer of the encoded value. Step (1) is where bounded encodings+-- are used. We must use a bounded encoding, as we must check that there is+-- enough free space /before/ actually writing to the buffer.+--+-- In term of expressivity, it would be sufficient to construct all encodings+-- from the single bounded encoding that encodes a 'Word8' as-is. However,+-- this is not sufficient in terms of efficiency. It results in unnecessary+-- buffer-full checks and it complicates the program-flow for writing to the+-- buffer, as buffer-full checks are interleaved with analyzing the value to be+-- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a+-- significant effect on overall encoding performance, as encoding primitive+-- Haskell values such as 'Word8's or 'Char's lies at the heart of every+-- encoding implementation.+--+-- The bounded 'Encoding's provided by this module remove this performance+-- problem. Intuitively, they consist of a tuple of the bound on the maximal+-- number of bytes written and the actual implementation of the encoding as a+-- function that modifies a mutable buffer. Hence when executing a bounded+-- 'Encoding', the buffer-full check can be done once before the actual writing+-- to the buffer. The provided 'Encoding's also take care to implement the+-- actual writing to the buffer efficiently. Moreover, combinators are+-- provided to construct new bounded encodings from the provided ones.+--+-- A typical example for using the combinators is a bounded 'Encoding' that+-- combines escaping the ' and \\ characters with UTF-8 encoding. More+-- precisely, the escaping to be done is the one implemented by the following+-- @escape@ function.+--+-- > escape :: Char -> [Char]+-- > escape '\'' = "\\'"+-- > escape '\\' = "\\\\"+-- > escape c    = [c]+--+-- The bounded 'Encoding' that combines this escaping with UTF-8 encoding is+-- the following.+--+-- > import Data.ByteString.Builder.Prim.Utf8 (char)+-- >+-- > {-# INLINE escapeChar #-}+-- > escapeUtf8 :: BoundedPrim Char+-- > escapeUtf8 =+-- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $+-- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $+-- >     char+--+-- The definition of 'escapeUtf8' is more complicated than 'escape', because+-- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in+-- 'escapeChar' compute both the bound on the maximal number of bytes written+-- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required+-- to implement the encoding. Bounded 'Encoding's should always be inlined.+-- Otherwise, the compiler cannot compute the bound on the maximal number of+-- bytes written at compile-time. Without inlinining, it would also fail to+-- optimize the constant encoding of the escape characters in the above+-- example. Functions that execute bounded 'Encoding's also perform+-- suboptimally, if the definition of the bounded 'Encoding' is not inlined.+-- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.+--+-- Currently, the only library that executes bounded 'Encoding's is the+-- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It+-- uses bounded 'Encoding's to implement most of its lazy bytestring builders.+-- Executing a bounded encoding should be done using the corresponding+-- functions in the lazy bytestring builder 'Extras' module.+--+-- TODO: Merge with explanation/example below+--+-- Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by+-- writing a bounded-size sequence of bytes directly to memory. They are+-- lifted to conversions from Haskell values to 'Builder's by wrapping them+-- with a bound-check. The compiler can implement this bound-check very+-- efficiently (i.e, a single comparison of the difference of two pointers to a+-- constant), because the bound of a 'E.Encoding' is always independent of the+-- value being encoded and, in most cases, a literal constant.+--+-- 'E.Encoding's are the primary means for defining conversion functions from+-- primitive Haskell values to 'Builder's. Most 'Builder' constructors+-- provided by this library are implemented that way.+-- 'E.Encoding's are also used to construct conversions that exploit the internal+-- representation of data-structures.+--+-- For example, 'encodeByteStringWith' works directly on the underlying byte+-- array and uses some tricks to reduce the number of variables in its inner+-- loop. Its efficiency is exploited for implementing the @filter@ and @map@+-- functions in "Data.ByteString.Lazy" as+--+-- > import qualified Data.ByteString.Builder.Prim as P+-- >+-- > filter :: (Word8 -> Bool) -> ByteString -> ByteString+-- > filter p = toLazyByteString . encodeLazyByteStringWithB write+-- >   where+-- >     write = P.condB p P.word8 P.emptyB+-- >+-- > map :: (Word8 -> Word8) -> ByteString -> ByteString+-- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)+--+-- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,+-- these versions use a more efficient inner loop and have the additional+-- advantage that they always result in well-chunked 'L.ByteString's; i.e, they+-- also perform automatic defragmentation.+--+-- We can also use 'E.Encoding's to improve the efficiency of the following+-- 'renderString' function from our UTF-8 CSV table encoding example in+-- "Data.ByteString.Builder".+--+-- > renderString :: String -> Builder+-- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'+-- >   where+-- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'+-- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'+-- >     escape c    = charUtf8 c+--+-- The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes+-- characters and using 'encodeListWith', which implements writing a list of+-- values with a tighter inner loop and no 'mappend'.+--+-- > import Data.ByteString.Builder.Extra     -- assume these+-- > import Data.ByteString.Builder.Prim      -- imports are present+-- >        ( BoundedPrim, encodeIf, (<#>), (#.) )+-- > import Data.ByteString.Builder.Prim.Utf8 (char)+-- >+-- > renderString :: String -> Builder+-- > renderString cs =+-- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'+-- >   where+-- >     escapedUtf8 :: BoundedPrim Char+-- >     escapedUtf8 =+-- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $+-- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $+-- >       char+--+-- This 'Builder' considers a buffer with less than 8 free bytes as full. As+-- all functions are inlined, the compiler is able to optimize the constant+-- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of+-- 'renderString' this implementation is 1.7x faster.+--+-}+{-+Internally, 'Builder's are buffer-fill operations that are+given a continuation buffer-fill operation and a buffer-range to be filled.+A 'Builder' first checks if the buffer-range is large enough. If that's+the case, the 'Builder' writes the sequences of bytes to the buffer and+calls its continuation.  Otherwise, it returns a signal that it requires a+new buffer together with a continuation to be called on this new buffer.+Ignoring the rare case of a full buffer-range, the execution cost of a+'Builder' consists of three parts:++  1. The time taken to read the parameters; i.e., the buffer-fill+     operation to call after the 'Builder' is done and the buffer-range to+     fill.++  2. The time taken to check for the size of the buffer-range.++  3. The time taken for the actual encoding.++We can reduce cost (1) by ensuring that fewer buffer-fill function calls are+required. We can reduce cost (2) by fusing buffer-size checks of sequential+writes. For example, when escaping a 'String' using 'renderString', it would+be sufficient to check before encoding a character that at least 8 bytes are+free. We can reduce cost (3) by implementing better primitive 'Builder's.+For example, 'renderCell' builds an intermediate list containing the decimal+representation of an 'Int'. Implementing a direct decimal encoding of 'Int's+to memory would be more efficient, as it requires fewer buffer-size checks+and less allocation. It is also a planned extension of this library.++The first two cost reductions are supported for user code through functions+in "Data.ByteString.Builder.Extra". There, we continue the above example+and drop the generation time to 0.8ms by implementing 'renderString' more+cleverly. The third reduction requires meddling with the internals of+'Builder's and is not recomended in code outside of this library. However,+patches to this library are very welcome.+-}+module Data.ByteString.Builder.Prim.Extra (++  -- * Base-128, variable-length binary encodings+  {- |+There are many options for implementing a base-128 (i.e, 7-bit),+variable-length encoding. The encoding implemented here is the one used by+Google's protocol buffer library+<http://code.google.com/apis/protocolbuffers/docs/encoding.html#varints>.  This+encoding can be implemented efficiently and provides the desired property that+small positive integers result in short sequences of bytes. It is intended to+be used for the new default binary serialization format of the differently+sized 'Word' types. It works as follows.++The most-significant bit (MSB) of each output byte indicates whether+there is a following byte (MSB set to 1) or it is the last byte (MSB set to 0).+The remaining 7-bits are used to encode the input starting with the least+significant 7-bit group of the input (i.e., a little-endian ordering of the+7-bit groups is used).++For example, the value @1 :: Int@ is encoded as @[0x01]@. The value+@128 :: Int@, whose binary representation is @1000 0000@, is encoded as+@[0x80, 0x01]@; i.e., the first byte has its MSB set and the least significant+7-bit group is @000 0000@, the second byte has its MSB not set (it is the last+byte) and its 7-bit group is @000 0001@.+-}+    word8Var+  , word16Var+  , word32Var+  , word64Var+  , wordVar++{- |+The following encodings work by casting the signed integer to the equally sized+unsigned integer. This works well for positive integers, but for negative+integers it always results in the longest possible sequence of bytes,+as their MSB is (by definition) always set.+-}++  , int8Var+  , int16Var+  , int32Var+  , int64Var+  , intVar++{- |+Positive and negative integers of small magnitude can be encoded compactly+  using the so-called ZigZag encoding+  (<http://code.google.com/apis/protocolbuffers/docs/encoding.html#types>).+The /ZigZag encoding/ uses+  even numbers to encode the postive integers and+  odd numbers to encode the negative integers.+For example,+  @0@ is encoded as @0@, @-1@ as @1@, @1@ as @2@, @-2@ as @3@, @2@ as @4@, and+  so on.+Its efficient implementation uses some bit-level magic.+For example++@+zigZag32 :: 'Int32' -> 'Word32'+zigZag32 n = fromIntegral ((n \`shiftL\` 1) \`xor\` (n \`shiftR\` 31))+@++Note that the 'shiftR' is an arithmetic shift that performs sign extension.+The ZigZag encoding essentially swaps the LSB with the MSB and additionally+inverts all bits if the MSB is set.++The following encodings implement the combintion of ZigZag encoding+  together with the above base-128, variable length encodings.+They are intended to become the the new default binary serialization format of+  the differently sized 'Int' types.+-}+  , int8VarSigned+  , int16VarSigned+  , int32VarSigned+  , int64VarSigned+  , intVarSigned+++  -- * Chunked / size-prefixed encodings+{- |+Some encodings like ASN.1 BER <http://en.wikipedia.org/wiki/Basic_Encoding_Rules>+or Google's protocol buffers <http://code.google.com/p/protobuf/> require+encoded data to be prefixed with its length. The simple method to achieve this+is to encode the data first into a separate buffer, compute the length of the+encoded data, write it to the current output buffer, and append the separate+buffers. The drawback of this method is that it requires a ...+-}+  , size+  , sizeBound+  -- , withSizeFB+  -- , withSizeBB+  , encodeWithSize++  , encodeChunked++  , wordVarFixedBound+  , wordHexFixedBound+  , wordDecFixedBound++  , word64VarFixedBound+  , word64HexFixedBound+  , word64DecFixedBound++  ) where++import           Data.ByteString.Builder.Internal+import           Data.ByteString.Builder.Prim.Internal.UncheckedShifts+import           Data.ByteString.Builder.Prim.Internal.Base16 (lowerTable, encode4_as_8)++import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++import           Data.Monoid+import           Data.List (unfoldr)  -- HADDOCK ONLY+import           Data.Char (chr, ord)+import           Control.Monad ((<=<), unless)++import           Data.ByteString.Builder.Prim.Internal hiding (size, sizeBound)+import qualified Data.ByteString.Builder.Prim.Internal as I (size, sizeBound)+import           Data.ByteString.Builder.Prim.Binary+import           Data.ByteString.Builder.Prim.ASCII+import           Data.ByteString.Builder.Prim++import           Foreign++------------------------------------------------------------------------------+-- Adapting 'size' for the public interface.+------------------------------------------------------------------------------++-- | The size of the sequence of bytes generated by this 'FixedPrim'.+size :: FixedPrim a -> Word+size = fromIntegral . I.size++-- | The bound on the size of the sequence of bytes generated by this+-- 'BoundedPrim'.+sizeBound :: BoundedPrim a -> Word+sizeBound = fromIntegral . I.sizeBound+++------------------------------------------------------------------------------+-- Base-128 Variable-Length Encodings+------------------------------------------------------------------------------++{-# INLINE encodeBase128 #-}+encodeBase128+    :: forall a b. (Integral a, Bits a, Storable b, Integral b, Num b)+    => (a -> Int -> a) -> BoundedPrim b+encodeBase128 shiftr =+    -- We add 6 because we require the result of (`div` 7) to be rounded up.+    boundedEncoding ((8 * sizeOf (undefined :: b) + 6) `div` 7) (io . fromIntegral)+  where+    io !x !op+      | x' == 0   = do poke8 (x .&. 0x7f)+                       return $! op `plusPtr` 1+      | otherwise = do poke8 ((x .&. 0x7f) .|. 0x80)+                       io x' (op `plusPtr` 1)+      where+        x'    = x `shiftr` 7+        poke8 = poke op . fromIntegral++-- | Base-128, variable length encoding of a 'Word8'.+{-# INLINE word8Var #-}+word8Var :: BoundedPrim Word8+word8Var = encodeBase128 shiftr_w++-- | Base-128, variable length encoding of a 'Word16'.+{-# INLINE word16Var #-}+word16Var :: BoundedPrim Word16+word16Var = encodeBase128 shiftr_w++-- | Base-128, variable length encoding of a 'Word32'.+{-# INLINE word32Var #-}+word32Var :: BoundedPrim Word32+word32Var = encodeBase128 shiftr_w32++-- | Base-128, variable length encoding of a 'Word64'.+{-# INLINE word64Var #-}+word64Var :: BoundedPrim Word64+word64Var = encodeBase128 shiftr_w64++-- | Base-128, variable length encoding of a 'Word'.+{-# INLINE wordVar #-}+wordVar :: BoundedPrim Word+wordVar = encodeBase128 shiftr_w+++-- | Base-128, variable length encoding of an 'Int8'.+-- Use 'int8VarSigned' for encoding negative numbers.+{-# INLINE int8Var #-}+int8Var :: BoundedPrim Int8+int8Var = fromIntegral >$< word8Var++-- | Base-128, variable length encoding of an 'Int16'.+-- Use 'int16VarSigned' for encoding negative numbers.+{-# INLINE int16Var #-}+int16Var :: BoundedPrim Int16+int16Var = fromIntegral >$< word16Var++-- | Base-128, variable length encoding of an 'Int32'.+-- Use 'int32VarSigned' for encoding negative numbers.+{-# INLINE int32Var #-}+int32Var :: BoundedPrim Int32+int32Var = fromIntegral >$< word32Var++-- | Base-128, variable length encoding of an 'Int64'.+-- Use 'int64VarSigned' for encoding negative numbers.+{-# INLINE int64Var #-}+int64Var :: BoundedPrim Int64+int64Var = fromIntegral >$< word64Var++-- | Base-128, variable length encoding of an 'Int'.+-- Use 'intVarSigned' for encoding negative numbers.+{-# INLINE intVar #-}+intVar :: BoundedPrim Int+intVar = fromIntegral >$< wordVar++{-# INLINE zigZag #-}+zigZag :: (Storable a, Bits a) => a -> a+zigZag x = (x `shiftL` 1) `xor` (x `shiftR` (8 * sizeOf x - 1))++-- | Base-128, variable length, ZigZag encoding of an 'Int'.+{-# INLINE int8VarSigned #-}+int8VarSigned :: BoundedPrim Int8+int8VarSigned = zigZag >$< int8Var++-- | Base-128, variable length, ZigZag encoding of an 'Int16'.+{-# INLINE int16VarSigned #-}+int16VarSigned :: BoundedPrim Int16+int16VarSigned = zigZag >$< int16Var++-- | Base-128, variable length, ZigZag encoding of an 'Int32'.+{-# INLINE int32VarSigned #-}+int32VarSigned :: BoundedPrim Int32+int32VarSigned = zigZag >$< int32Var++-- | Base-128, variable length, ZigZag encoding of an 'Int64'.+{-# INLINE int64VarSigned #-}+int64VarSigned :: BoundedPrim Int64+int64VarSigned = zigZag >$< int64Var++-- | Base-128, variable length, ZigZag encoding of an 'Int'.+{-# INLINE intVarSigned #-}+intVarSigned :: BoundedPrim Int+intVarSigned = zigZag >$< intVar++++------------------------------------------------------------------------------+-- Chunked Encoding Transformer+------------------------------------------------------------------------------++-- | /Heavy inlining./+{-# INLINE encodeChunked #-}+encodeChunked+    :: Word                           -- ^ Minimal free-size+    -> (Word64 -> FixedPrim Word64)+    -- ^ Given a sizeBound on the maximal encodable size this function must return+    -- a fixed-size encoding for encoding all smaller size.+    -> (BoundedPrim Word64)+    -- ^ An encoding for terminating a chunk of the given size.+    -> Builder+    -- ^ Inner Builder to transform+    -> Builder+    -- ^ 'Put' with chunked encoding.+encodeChunked minFree mkBeforeFE afterBE =+    fromPut . putChunked minFree mkBeforeFE afterBE . putBuilder++-- | /Heavy inlining./+{-# INLINE putChunked #-}+putChunked+    :: Word                         -- ^ Minimal free-size+    -> (Word64 -> FixedPrim Word64)+    -- ^ Given a sizeBound on the maximal encodable size this function must return+    -- a fixed-size encoding for encoding all smaller size.+    -> (BoundedPrim Word64)+    -- ^ Encoding a directly inserted chunk.+    -> Put a+    -- ^ Inner Put to transform+    -> Put a+    -- ^ 'Put' with chunked encoding.+putChunked minFree0 mkBeforeFE afterBE p =+    put encodingStep+  where+    minFree, reservedAfter, maxReserved, minBufferSize :: Int+    minFree       = fromIntegral $ max 1 minFree0   -- sanitize and convert to Int++    -- reserved space must be computed for maximum buffer size to cover for all+    -- sizes of the actually returned buffer.+    reservedAfter = I.sizeBound afterBE+    maxReserved   = I.size (mkBeforeFE maxBound) + reservedAfter+    minBufferSize = minFree + maxReserved++    encodingStep k =+        fill (runPut p)+      where+        fill innerStep !(BufferRange op ope)+          | outRemaining < minBufferSize =+              return $! bufferFull minBufferSize op (fill innerStep)+          | otherwise = do+              fillWithBuildStep innerStep doneH fullH insertChunksH brInner+          where+            outRemaining   = ope `minusPtr` op+            beforeFE       = mkBeforeFE $ fromIntegral outRemaining+            reservedBefore = I.size beforeFE++            opInner        = op  `plusPtr` reservedBefore+            opeInner       = ope `plusPtr` (-reservedAfter)+            brInner        = BufferRange opInner opeInner++            wrapChunk :: Ptr Word8 -> IO (Ptr Word8)+            wrapChunk !opInner'+              | innerSize == 0 = return op -- no data written => no chunk to wrap+              | otherwise      = do+                  runF beforeFE innerSize op+                  runB afterBE innerSize opInner'+              where+                innerSize = fromIntegral $ opInner' `minusPtr` opInner++            doneH opInner' x = do+                op' <- wrapChunk opInner'+                let !br' = BufferRange op' ope+                k x br'++            fullH opInner' minSize nextInnerStep = do+                op' <- wrapChunk opInner'+                return $! bufferFull+                  (max minBufferSize (minSize + maxReserved))+                  op'+                  (fill nextInnerStep)++            insertChunksH opInner' n lbsC nextInnerStep+              | n == 0 = do                      -- flush+                  op' <- wrapChunk opInner'+                  return $! insertChunks op' 0 id (fill nextInnerStep)++              | otherwise = do                   -- insert non-empty bytestring+                  op' <- wrapChunk opInner'+                  let !br' = BufferRange op' ope+                  runBuilderWith chunkB (fill nextInnerStep) br'+              where+                nU     = fromIntegral n+                chunkB =+                  primFixed (mkBeforeFE nU) nU `mappend`+                  lazyByteStringC n lbsC         `mappend`+                  primBounded afterBE nU+++-- | /Heavy inlining./ Prefix a 'Builder' with the size of the+-- sequence of bytes that it denotes.+--+-- This function is optimized for streaming use. It tries to prefix the size+-- without copying the output. This is achieved by reserving space for the+-- maximum size to be encoded. This succeeds if the output is smaller than+-- the current free buffer size, which is guaranteed to be at least @8kb@.+--+-- If the output does not fit into the current free buffer size,+-- the method falls back to encoding the data to a separate lazy bytestring,+-- computing the size, and encoding the size before inserting the chunks of+-- the separate lazy bytestring.+{-# INLINE encodeWithSize #-}+encodeWithSize+    ::+       Word+    -- ^ Inner buffer-size.+    -> (Word64 -> FixedPrim Word64)+    -- ^ Given a bound on the maximal size to encode, this function must return+    -- a fixed-size encoding for all smaller sizes.+    -> Builder+    -- ^ 'Put' to prefix with the length of its sequence of bytes.+    -> Builder+encodeWithSize innerBufSize mkSizeFE =+    fromPut . putWithSize innerBufSize mkSizeFE . putBuilder++-- | Prefix a 'Put' with the size of its written data.+{-# INLINE putWithSize #-}+putWithSize+    :: forall a.+       Word+    -- ^ Buffer-size for inner driver.+    -> (Word64 -> FixedPrim Word64)+    -- ^ Encoding the size for the fallback case.+    -> Put a+    -- ^ 'Put' to prefix with the length of its sequence of bytes.+    -> Put a+putWithSize innerBufSize mkSizeFE innerP =+    put $ encodingStep+  where+    -- | The minimal free size is such that we can encode any size.+    minFree = I.size $ mkSizeFE maxBound++    encodingStep :: (forall r. (a -> BuildStep r) -> BuildStep r)+    encodingStep k =+        fill (runPut innerP)+      where+        fill :: BuildStep a -> BufferRange -> IO (BuildSignal r)+        fill innerStep !(BufferRange op ope)+          | outRemaining < minFree =+              return $! bufferFull minFree op (fill innerStep)+          | otherwise = do+              fillWithBuildStep innerStep doneH fullH insertChunksH brInner+          where+            outRemaining   = ope `minusPtr` op+            sizeFE         = mkSizeFE $ fromIntegral outRemaining+            reservedBefore = I.size sizeFE+            reservedAfter  = minFree - reservedBefore++            -- leave enough free space such that all sizes can be encodded.+            startInner    = op  `plusPtr` reservedBefore+            opeInner      = ope `plusPtr` (negate reservedAfter)+            brInner       = BufferRange startInner opeInner++            fastPrefixSize :: Ptr Word8 -> IO (Ptr Word8)+            fastPrefixSize !opInner'+              | innerSize == 0 = do runB (toB $ mkSizeFE 0) 0         op+              | otherwise      = do runF (sizeFE)           innerSize op+                                    return opInner'+              where+                innerSize = fromIntegral $ opInner' `minusPtr` startInner++            slowPrefixSize :: Ptr Word8 -> Builder -> BuildStep a -> IO (BuildSignal r)+            slowPrefixSize opInner' bInner nextStep = do+                (x, chunks, payLenChunks) <- toLBS $ runBuilderWith bInner nextStep++                let -- length of payload data in current buffer+                    payLenCur   = opInner' `minusPtr` startInner+                    -- length of whole payload+                    payLen      = fromIntegral payLenCur + fromIntegral payLenChunks+                    -- encoder for payload length+                    sizeFE'     = mkSizeFE payLen+                    -- start of payload in current buffer with the payload+                    -- length encoded before+                    startInner' = op `plusPtr` I.size sizeFE'++                -- move data in current buffer out of the way, if required+                unless (startInner == startInner') $+                    moveBytes startInner' startInner payLenCur+                -- encode payload length at start of the buffer+                runF sizeFE' payLen op+                -- TODO: If we were to change the CIOS definition such that it also+                -- returns the last buffer for writing, we could also fill the+                -- last buffer with 'k' and return the signal, once it is+                -- filled, therefore avoiding unfilled space.+                return $ insertChunks (startInner' `plusPtr` payLenCur)+                                      payLenChunks+                                      chunks+                                      (k x)+              where+                toLBS = runCIOSWithLength <=<+                    buildStepToCIOSUntrimmedWith (fromIntegral innerBufSize)++            doneH :: Ptr Word8 -> a -> IO (BuildSignal r)+            doneH opInner' x = do+                op' <- fastPrefixSize opInner'+                let !br' = BufferRange op' ope+                k x br'++            fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (BuildSignal r)+            fullH opInner' minSize nextInnerStep =+                slowPrefixSize opInner' (ensureFree minSize) nextInnerStep++            insertChunksH :: Ptr Word8 -> Int64 -> LazyByteStringC+                          -> BuildStep a -> IO (BuildSignal r)+            insertChunksH opInner' n lbsC nextInnerStep =+                slowPrefixSize opInner' (lazyByteStringC n lbsC) nextInnerStep+++-- | Run a 'ChunkIOStream' and gather its results and their length.+runCIOSWithLength :: ChunkIOStream a -> IO (a, LazyByteStringC, Int64)+runCIOSWithLength =+    go 0 id+  where+    go !l lbsC (Finished x)        = return (x, lbsC, l)+    go !l lbsC (YieldC n lbsC' io) = io >>= go (l + n) (lbsC . lbsC')+    go !l lbsC (Yield1 bs io)      =+        io >>= go (l + fromIntegral (S.length bs)) (lbsC . L.Chunk bs)++-- | Run a 'BuildStep' using the untrimmed strategy.+buildStepToCIOSUntrimmedWith :: Int -> BuildStep a -> IO (ChunkIOStream a)+buildStepToCIOSUntrimmedWith bufSize =+    buildStepToCIOS (untrimmedStrategy bufSize bufSize)+                    (return . Finished)+++----------------------------------------------------------------------+-- Padded versions of encodings for streamed prefixing of output sizes+----------------------------------------------------------------------++{-# INLINE appsUntilZero #-}+appsUntilZero :: (Eq a, Num a) => (a -> a) -> a -> Int+appsUntilZero f x0 =+    count 0 x0+  where+    count !n 0 = n+    count !n x = count (succ n) (f x)+++{-# INLINE genericVarFixedBound #-}+genericVarFixedBound :: (Eq b, Show b, Bits b, Num a, Integral b)+                => (b -> a -> b) -> b -> FixedPrim b+genericVarFixedBound shiftRight bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`shiftRight` 7) bound++    io !x0 !op+      | x0 > bound = error err+      | otherwise  = loop 0 x0+      where+        err = "genericVarFixedBound: value " ++ show x0 ++ " > bound " ++ show bound+        loop !n !x+          | n0 <= n + 1 = do poke8 (x .&. 0x7f)+          | otherwise   = do poke8 ((x .&. 0x7f) .|. 0x80)+                             loop (n + 1) (x `shiftRight` 7)+          where+            poke8 = pokeElemOff op n . fromIntegral++{-# INLINE wordVarFixedBound #-}+wordVarFixedBound :: Word -> FixedPrim Word+wordVarFixedBound = genericVarFixedBound shiftr_w++{-# INLINE word64VarFixedBound #-}+word64VarFixedBound :: Word64 -> FixedPrim Word64+word64VarFixedBound = genericVarFixedBound shiftr_w64+++-- Somehow this function doesn't really make sense, as the bound must be+-- greater when interpreted as an unsigned integer. These conversions and+-- decisions should be left to the user.+--+--{-# INLINE intVarFixed #-}+--intVarFixed :: Size -> FixedPrim Size+--intVarFixed bound = fromIntegral >$< wordVarFixed (fromIntegral bound)++{-# INLINE genHexFixedBound #-}+genHexFixedBound :: (Num a, Bits a, Integral a)+                 => (a -> Int -> a) -> Char -> a -> FixedPrim a+genHexFixedBound shiftr padding0 bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`shiftr` 4) bound++    padding = fromIntegral (ord padding0) :: Word8++    io !x0 !op0 =+        loop (op0 `plusPtr` n0) x0+      where+        loop !op !x = do+           let !op' = op `plusPtr` (-1)+           poke op' =<< encode4_as_8 lowerTable (fromIntegral $ x .&. 0xf)+           let !x' = x `shiftr` 4+           unless (op' <= op0) $+             if x' == 0+               then pad (op' `plusPtr` (-1))+               else loop op' x'++        pad !op+          | op < op0  = return ()+          | otherwise = poke op padding >> pad (op `plusPtr` (-1))+++{-# INLINE wordHexFixedBound #-}+wordHexFixedBound :: Char -> Word -> FixedPrim Word+wordHexFixedBound = genHexFixedBound shiftr_w++{-# INLINE word64HexFixedBound #-}+word64HexFixedBound :: Char -> Word64 -> FixedPrim Word64+word64HexFixedBound = genHexFixedBound shiftr_w64++-- | Note: Works only for positive numbers.+{-# INLINE genDecFixedBound #-}+genDecFixedBound :: (Num a, Bits a, Integral a)+                 => Char -> a -> FixedPrim a+genDecFixedBound padding0 bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`div` 10) bound++    padding = fromIntegral (ord padding0) :: Word8++    io !x0 !op0 =+        loop (op0 `plusPtr` n0) x0+      where+        loop !op !x = do+           let !op' = op `plusPtr` (-1)+               !x'  = x `div` 10+           poke op' ((fromIntegral $ (x - x' * 10) + 48) :: Word8)+           unless (op' <= op0) $+             if x' == 0+               then pad (op' `plusPtr` (-1))+               else loop op' x'++        pad !op+          | op < op0  = return ()+          | otherwise = poke op padding >> pad (op `plusPtr` (-1))++{-# INLINE wordDecFixedBound #-}+wordDecFixedBound :: Char -> Word -> FixedPrim Word+wordDecFixedBound = genDecFixedBound++{-# INLINE word64DecFixedBound #-}+word64DecFixedBound :: Char -> Word64 -> FixedPrim Word64+word64DecFixedBound = genDecFixedBound+

@@ -0,0 +1,361 @@+{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Copyright   : 2010-2011 Simon Meier, 2010 Jasper van der Jeugt+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : unstable, private+-- Portability : GHC+--+-- *Warning:* this module is internal. If you find that you need it please+-- contact the maintainers and explain what you are trying to do and discuss+-- what you would need in the public API. It is important that you do this as+-- the module may not be exposed at all in future releases.+--+-- The maintainers are glad to accept patches for further+-- standard encodings of standard Haskell values.+--+-- If you need to write your own builder primitives, then be aware that you are+-- writing code with /all saftey belts off/; i.e.,+-- *this is the code that might make your application vulnerable to buffer-overflow attacks!*+-- The "Data.ByteString.Builder.Prim.Tests" module provides you with+-- utilities for testing your encodings thoroughly.+--+module Data.ByteString.Builder.Prim.Internal (+  -- * Fixed-size builder primitives+    Size+  , FixedPrim+  , fixedEncoding+  , size+  , runF++  , emptyF+  , contramapF+  , pairF+  -- , liftIOF++  , storableToF++  -- * Bounded-size builder primitives+  , BoundedPrim+  , boundedEncoding+  , sizeBound+  , runB++  , emptyB+  , contramapB+  , pairB+  , eitherB+  , condB++  -- , liftIOB++  , toB+  , liftFixedToBounded++  -- , withSizeFB+  -- , withSizeBB++  -- * Shared operators+  , (>$<)+  , (>*<)++  ) where++import Foreign+import Prelude hiding (maxBound)++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 611+-- ghc-6.10 and older do not support {-# INLINE CONLIKE #-}+#define CONLIKE+#endif++------------------------------------------------------------------------------+-- Supporting infrastructure+------------------------------------------------------------------------------++-- | Contravariant functors as in the @contravariant@ package.+class Contravariant f where+    contramap :: (b -> a) -> f a -> f b++infixl 4 >$<++-- | A fmap-like operator for builder primitives, both bounded and fixed size.+--+-- Builder primitives are contravariant so it's like the normal fmap, but+-- backwards (look at the type). (If it helps to remember, the operator symbol+-- is like (<$>) but backwards.)+--+-- We can use it for example to prepend and/or append fixed values to an+-- primitive.+--+-- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'"+-- >  where+-- >    fixed3 = char7 >*< char7 >*< char7+--+-- Note that the rather verbose syntax for composition stems from the+-- requirement to be able to compute the size / size bound at compile time.+--+(>$<) :: Contravariant f => (b -> a) -> f a -> f b+(>$<) = contramap+++instance Contravariant FixedPrim where+    contramap = contramapF++instance Contravariant BoundedPrim where+    contramap = contramapB+++-- | Type-constructors supporting lifting of type-products.+class Monoidal f where+    pair :: f a -> f b -> f (a, b)++instance Monoidal FixedPrim where+    pair = pairF++instance Monoidal BoundedPrim where+    pair = pairB++infixr 5 >*<++-- | A pairing/concatenation operator for builder primitives, both bounded and+-- fixed size.+--+-- For example,+--+-- > toLazyByteString (primFixed (char7 >*< char7) ('x','y')) = "xy"+--+-- We can combine multiple primitives using '>*<' multiple times.+--+-- > toLazyByteString (primFixed (char7 >*< char7 >*< char7) ('x',('y','z'))) = "xyz"+--+(>*<) :: Monoidal f => f a -> f b -> f (a, b)+(>*<) = pair+++-- | The type used for sizes and sizeBounds of sizes.+type Size = Int+++------------------------------------------------------------------------------+-- Fixed-size builder primitives+------------------------------------------------------------------------------++-- | A builder primitive that always results in a sequence of bytes of a+-- pre-determined, fixed size.+data FixedPrim a = FE {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO ())++fixedEncoding :: Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a+fixedEncoding = FE++-- | The size of the sequences of bytes generated by this 'FixedPrim'.+{-# INLINE CONLIKE size #-}+size :: FixedPrim a -> Int+size (FE l _) = l++{-# INLINE CONLIKE runF #-}+runF :: FixedPrim a -> a -> Ptr Word8 -> IO ()+runF (FE _ io) = io++-- | The 'FixedPrim' that always results in the zero-length sequence.+{-# INLINE CONLIKE emptyF #-}+emptyF :: FixedPrim a+emptyF = FE 0 (\_ _ -> return ())++-- | Encode a pair by encoding its first component and then its second component.+{-# INLINE CONLIKE pairF #-}+pairF :: FixedPrim a -> FixedPrim b -> FixedPrim (a, b)+pairF (FE l1 io1) (FE l2 io2) =+    FE (l1 + l2) (\(x1,x2) op -> io1 x1 op >> io2 x2 (op `plusPtr` l1))++-- | Change a primitives such that it first applies a function to the value+-- to be encoded.+--+-- Note that primitives are 'Contrafunctors'+-- <http://hackage.haskell.org/package/contravariant>. Hence, the following+-- laws hold.+--+-- >contramapF id = id+-- >contramapF f . contramapF g = contramapF (g . f)+{-# INLINE CONLIKE contramapF #-}+contramapF :: (b -> a) -> FixedPrim a -> FixedPrim b+contramapF f (FE l io) = FE l (\x op -> io (f x) op)++-- | Convert a 'FixedPrim' to a 'BoundedPrim'.+{-# INLINE CONLIKE toB #-}+toB :: FixedPrim a -> BoundedPrim a+toB (FE l io) = BE l (\x op -> io x op >> (return $! op `plusPtr` l))++-- | Lift a 'FixedPrim' to a 'BoundedPrim'.+{-# INLINE CONLIKE liftFixedToBounded #-}+liftFixedToBounded :: FixedPrim a -> BoundedPrim a+liftFixedToBounded = toB++{-# INLINE CONLIKE storableToF #-}+storableToF :: forall a. Storable a => FixedPrim a+storableToF = FE (sizeOf (undefined :: a)) (\x op -> poke (castPtr op) x)++{-+{-# INLINE CONLIKE liftIOF #-}+liftIOF :: FixedPrim a -> FixedPrim (IO a)+liftIOF (FE l io) = FE l (\xWrapped op -> do x <- xWrapped; io x op)+-}++------------------------------------------------------------------------------+-- Bounded-size builder primitives+------------------------------------------------------------------------------++-- | A builder primitive that always results in sequence of bytes that is no longer+-- than a pre-determined bound.+data BoundedPrim a = BE {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO (Ptr Word8))++-- | The bound on the size of sequences of bytes generated by this 'BoundedPrim'.+{-# INLINE CONLIKE sizeBound #-}+sizeBound :: BoundedPrim a -> Int+sizeBound (BE b _) = b++boundedEncoding :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a+boundedEncoding = BE++{-# INLINE CONLIKE runB #-}+runB :: BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)+runB (BE _ io) = io++-- | Change a 'BoundedPrim' such that it first applies a function to the+-- value to be encoded.+--+-- Note that 'BoundedPrim's are 'Contrafunctors'+-- <http://hackage.haskell.org/package/contravariant>. Hence, the following+-- laws hold.+--+-- >contramapB id = id+-- >contramapB f . contramapB g = contramapB (g . f)+{-# INLINE CONLIKE contramapB #-}+contramapB :: (b -> a) -> BoundedPrim a -> BoundedPrim b+contramapB f (BE b io) = BE b (\x op -> io (f x) op)++-- | The 'BoundedPrim' that always results in the zero-length sequence.+{-# INLINE CONLIKE emptyB #-}+emptyB :: BoundedPrim a+emptyB = BE 0 (\_ op -> return op)++-- | Encode a pair by encoding its first component and then its second component.+{-# INLINE CONLIKE pairB #-}+pairB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)+pairB (BE b1 io1) (BE b2 io2) =+    BE (b1 + b2) (\(x1,x2) op -> io1 x1 op >>= io2 x2)++-- | Encode an 'Either' value using the first 'BoundedPrim' for 'Left'+-- values and the second 'BoundedPrim' for 'Right' values.+--+-- Note that the functions 'eitherB', 'pairB', and 'contramapB' (written below+-- using '>$<') suffice to construct 'BoundedPrim's for all non-recursive+-- algebraic datatypes. For example,+--+-- @+--maybeB :: BoundedPrim () -> BoundedPrim a -> BoundedPrim (Maybe a)+--maybeB nothing just = 'maybe' (Left ()) Right '>$<' eitherB nothing just+-- @+{-# INLINE CONLIKE eitherB #-}+eitherB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)+eitherB (BE b1 io1) (BE b2 io2) =+    BE (max b1 b2)+        (\x op -> case x of Left x1 -> io1 x1 op; Right x2 -> io2 x2 op)++-- | Conditionally select a 'BoundedPrim'.+-- For example, we can implement the ASCII primitive that drops characters with+-- Unicode codepoints above 127 as follows.+--+-- @+--charASCIIDrop = 'condB' (< '\128') ('fromF' 'char7') 'emptyB'+-- @+{-# INLINE CONLIKE condB #-}+condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a+condB p be1 be2 =+    contramapB (\x -> if p x then Left x else Right x) (eitherB be1 be2)+++{-+{-# INLINE withSizeFB #-}+withSizeFB :: (Word -> FixedPrim Word) -> BoundedPrim a -> BoundedPrim a+withSizeFB feSize (BE b io) =+    BE (lSize + b)+       (\x op0 -> do let !op1 = op0 `plusPtr` lSize+                     op2 <- io x op1+                     ioSize (fromIntegral $ op2 `minusPtr` op1) op0+                     return op2)+  where+    FE lSize ioSize = feSize (fromIntegral b)+++{-# INLINE withSizeBB #-}+withSizeBB :: BoundedPrim Word -> BoundedPrim a -> BoundedPrim a+withSizeBB (BE bSize ioSize) (BE b io) =+    BE (bSize + 2*b)+       (\x op0 -> do let !opTmp = op0 `plusPtr` (bSize + b)+                     opTmp' <- io x opTmp+                     let !s = opTmp' `minusPtr` opTmp+                     op1 <- ioSize (fromIntegral s) op0+                     copyBytes op1 opTmp s+                     return $! op1 `plusPtr` s)++{-# INLINE CONLIKE liftIOB #-}+liftIOB :: BoundedPrim a -> BoundedPrim (IO a)+liftIOB (BE l io) = BE l (\xWrapped op -> do x <- xWrapped; io x op)+-}++------------------------------------------------------------------------------+-- Builder primitives from 'ByteString's.+------------------------------------------------------------------------------++{-+-- | A 'FixedPrim' that always results in the same byte sequence given as a+-- strict 'S.ByteString'. We can use this primitive to insert fixed ...+{-# INLINE CONLIKE constByteStringF #-}+constByteStringF :: S.ByteString -> FixedPrim ()+constByteStringF bs =+    FE len io+  where+    (S.PS fp off len) = bs+    io _ op = do+        copyBytes op (unsafeForeignPtrToPtr fp `plusPtr` off) len+        touchForeignPtr fp++-- | Encode a fixed-length prefix of a strict 'S.ByteString' as-is. We can use+-- this function to+{-# INLINE byteStringPrefixB #-}+byteStringTakeB :: Int  -- ^ Length of the prefix. It should be smaller than+                        -- 100 bytes, as otherwise+                -> BoundedPrim S.ByteString+byteStringTakeB n0 =+    BE n io+  where+    n = max 0 n0 -- sanitize++    io (S.PS fp off len) op = do+        let !s = min len n+        copyBytes op (unsafeForeignPtrToPtr fp `plusPtr` off) s+        touchForeignPtr fp+        return $! op `plusPtr` s+-}++{-++httpChunkedTransfer :: Builder -> Builder+httpChunkedTransfer =+    encodeChunked 32 (word64HexFixedBound '0')+                     ((\_ -> ('\r',('\n',('\r','\n')))) >$< char8x4)+  where+    char8x4 = toB (char8 >*< char8 >*< char8 >*< char8)++++chunked :: Builder -> Builder+chunked = encodeChunked 16 word64VarFixedBound emptyB++-}+++

@@ -0,0 +1,116 @@+{-# LANGUAGE CPP #-}+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Hexadecimal encoding of nibbles (4-bit) and octets (8-bit) as ASCII+-- characters.+--+-- The current implementation is based on a table based encoding inspired by+-- the code in the 'base64-bytestring' library by Bryan O'Sullivan. In our+-- benchmarks on a 32-bit machine it turned out to be the fastest+-- implementation option.+--+module Data.ByteString.Builder.Prim.Internal.Base16 (+    EncodingTable+  -- , upperTable+  , lowerTable+  , encode4_as_8+  , encode8_as_16h+  -- , encode8_as_8_8+  ) where++import qualified Data.ByteString          as S+import qualified Data.ByteString.Internal as S++#if MIN_VERSION_base(4,4,0)+import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import           System.IO.Unsafe (unsafePerformIO)+#else+import           Foreign+#endif++-- Creating the encoding tables+-------------------------------++-- TODO: Use table from C implementation.++-- | An encoding table for Base16 encoding.+newtype EncodingTable = EncodingTable (ForeignPtr Word8)++tableFromList :: [Word8] -> EncodingTable+tableFromList xs = case S.pack xs of S.PS fp _ _ -> EncodingTable fp++unsafeIndex :: EncodingTable -> Int -> IO Word8+unsafeIndex (EncodingTable table) = peekElemOff (unsafeForeignPtrToPtr table)++base16EncodingTable :: EncodingTable -> IO EncodingTable+base16EncodingTable alphabet = do+    xs <- sequence $ concat $ [ [ix j, ix k] | j <- [0..15], k <- [0..15] ]+    return $ tableFromList xs+  where+    ix = unsafeIndex alphabet++{-+{-# NOINLINE upperAlphabet #-}+upperAlphabet :: EncodingTable+upperAlphabet =+    tableFromList $ map (fromIntegral . fromEnum) $ ['0'..'9'] ++ ['A'..'F']++-- | The encoding table for hexadecimal values with upper-case characters;+-- e.g., DEADBEEF.+{-# NOINLINE upperTable #-}+upperTable :: EncodingTable+upperTable = unsafePerformIO $ base16EncodingTable upperAlphabet+-}++{-# NOINLINE lowerAlphabet #-}+lowerAlphabet :: EncodingTable+lowerAlphabet =+    tableFromList $ map (fromIntegral . fromEnum) $ ['0'..'9'] ++ ['a'..'f']++-- | The encoding table for hexadecimal values with lower-case characters;+-- e.g., deadbeef.+{-# NOINLINE lowerTable #-}+lowerTable :: EncodingTable+lowerTable = unsafePerformIO $ base16EncodingTable lowerAlphabet+++-- Encoding nibbles and octets+------------------------------++-- | Encode a nibble as an octet.+--+-- > encode4_as_8 lowerTable 10 = fromIntegral (char 'a')+--+{-# INLINE encode4_as_8 #-}+encode4_as_8 :: EncodingTable -> Word8 -> IO Word8+encode4_as_8 table x = unsafeIndex table (2 * fromIntegral x + 1)+-- TODO: Use a denser table to reduce cache utilization.++-- | Encode an octet as 16bit word comprising both encoded nibbles ordered+-- according to the host endianness. Writing these 16bit to memory will write+-- the nibbles in the correct order (i.e. big-endian).+{-# INLINE encode8_as_16h #-}+encode8_as_16h :: EncodingTable -> Word8 -> IO Word16+encode8_as_16h (EncodingTable table) =+    peekElemOff (castPtr $ unsafeForeignPtrToPtr table) . fromIntegral++{-+-- | Encode an octet as a big-endian ordered tuple of octets; i.e.,+--+-- >   encode8_as_8_8 lowerTable 10+-- > = (fromIntegral (chr '0'), fromIntegral (chr 'a'))+--+{-# INLINE encode8_as_8_8 #-}+encode8_as_8_8 :: EncodingTable -> Word8 -> IO (Word8, Word8)+encode8_as_8_8 table x =+    (,) <$> unsafeIndex table i <*> unsafeIndex table (i + 1)+  where+    i = 2 * fromIntegral x+-}

@@ -0,0 +1,55 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Copyright   : (c) 2010 Simon Meier+--+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's.+--+module Data.ByteString.Builder.Prim.Internal.Floating+    (+      -- coerceFloatToWord32+    -- , coerceDoubleToWord64+    encodeFloatViaWord32F+  , encodeDoubleViaWord64F+  ) where++import Foreign+import Data.ByteString.Builder.Prim.Internal++{-+We work around ticket http://hackage.haskell.org/trac/ghc/ticket/4092 using the+FFI to store the Float/Double in the buffer and peek it out again from there.+-}+++-- | Encode a 'Float' using a 'Word32' encoding.+--+-- PRE: The 'Word32' encoding must have a size of at least 4 bytes.+{-# INLINE encodeFloatViaWord32F #-}+encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float+encodeFloatViaWord32F w32fe+  | size w32fe < sizeOf (undefined :: Float) =+      error $ "encodeFloatViaWord32F: encoding not wide enough"+  | otherwise = fixedEncoding (size w32fe) $ \x op -> do+      poke (castPtr op) x+      x' <- peek (castPtr op)+      runF w32fe x' op++-- | Encode a 'Double' using a 'Word64' encoding.+--+-- PRE: The 'Word64' encoding must have a size of at least 8 bytes.+{-# INLINE encodeDoubleViaWord64F #-}+encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double+encodeDoubleViaWord64F w64fe+  | size w64fe < sizeOf (undefined :: Float) =+      error $ "encodeDoubleViaWord64F: encoding not wide enough"+  | otherwise = fixedEncoding (size w64fe) $ \x op -> do+      poke (castPtr op) x+      x' <- peek (castPtr op)+      runF w64fe x' op+

@@ -0,0 +1,106 @@+{-# LANGUAGE CPP, MagicHash #-}+-- |+-- Copyright   : (c) 2010 Simon Meier+--+--               Original serialization code from 'Data.Binary.Builder':+--               (c) Lennart Kolmodin, Ross Patterson+--+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Utilty module defining unchecked shifts.+--+-- These functions are undefined when the amount being shifted by is+-- greater than the size in bits of a machine Int#.-+--+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.ByteString.Builder.Prim.Internal.UncheckedShifts (+    shiftr_w16+  , shiftr_w32+  , shiftr_w64+  , shiftr_w++  , caseWordSize_32_64+  ) where+++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word (Word32(..),Word16(..),Word64(..))++#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+import GHC.Word (uncheckedShiftRL64#)+#endif+#else+import Data.Word+#endif++import Foreign+++------------------------------------------------------------------------+-- Unchecked shifts++-- | Right-shift of a 'Word16'.+{-# INLINE shiftr_w16 #-}+shiftr_w16 :: Word16 -> Int -> Word16++-- | Right-shift of a 'Word32'.+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32++-- | Right-shift of a 'Word64'.+{-# INLINE shiftr_w64 #-}+shiftr_w64 :: Word64 -> Int -> Word64++-- | Right-shift of a 'Word'.+{-# INLINE shiftr_w #-}+shiftr_w :: Word -> Int -> Word+#if WORD_SIZE_IN_BITS < 64+shiftr_w w s = fromIntegral $ (`shiftr_w32` s) $ fromIntegral w+#else+shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w+#endif++#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)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftRL64"+    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#+#endif++#else+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)+#endif++#else+shiftr_w16 = shiftR+shiftr_w32 = shiftR+shiftr_w64 = shiftR+#endif+++-- | Select an implementation depending on the bit-size of 'Word's.+-- Currently, it produces a runtime failure if the bitsize is different.+-- This is detected by the testsuite.+{-# INLINE caseWordSize_32_64 #-}+caseWordSize_32_64 :: a -- Value to use for 32-bit 'Word's+                   -> a -- Value to use for 64-bit 'Word's+                   -> a+caseWordSize_32_64 f32 f64 = case bitSize (undefined :: Word) of+    32 -> f32+    64 -> f64+    s  -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s++

@@ -61,6 +61,7 @@         append,                 -- :: ByteString -> ByteString -> ByteString         head,                   -- :: ByteString -> Char         uncons,                 -- :: ByteString -> Maybe (Char, ByteString)+        unsnoc,                 -- :: ByteString -> Maybe (ByteString, Char)         last,                   -- :: ByteString -> Char         tail,                   -- :: ByteString -> ByteString         init,                   -- :: ByteString -> ByteString@@ -213,6 +214,7 @@         hGetLine,               -- :: Handle -> IO ByteString         hGetContents,           -- :: Handle -> IO ByteString         hGet,                   -- :: Handle -> Int -> IO ByteString+        hGetSome,               -- :: Handle -> Int -> IO ByteString         hGetNonBlocking,        -- :: Handle -> Int -> IO ByteString         hPut,                   -- :: Handle -> ByteString -> IO ()         hPutNonBlocking,        -- :: Handle -> ByteString -> IO ByteString@@ -245,7 +247,7 @@                        ,findSubstring,findSubstrings,breakSubstring,copy,group                         ,getLine, getContents, putStr, interact-                       ,hGetContents, hGet, hPut, hPutStr+                       ,hGetContents, hGet, hGetSome, hPut, hPutStr                        ,hGetLine, hGetNonBlocking, hPutNonBlocking                        ,packCString,packCStringLen                        ,useAsCString,useAsCStringLen@@ -256,7 +258,7 @@ import Data.Char    ( isSpace ) import qualified Data.List as List (intersperse) -import System.IO                (Handle,stdout,openFile,hClose,hFileSize,IOMode(..))+import System.IO    (Handle,stdout,openBinaryFile,hClose,hFileSize,IOMode(..)) #ifndef __NHC__ import Control.Exception        (bracket) #else@@ -321,6 +323,14 @@                   Just (w, bs') -> Just (w2c w, bs') {-# INLINE uncons #-} +-- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning Nothing+-- if it is empty.+unsnoc :: ByteString -> Maybe (ByteString, Char)+unsnoc bs = case B.unsnoc bs of+                  Nothing -> Nothing+                  Just (bs', w) -> Just (bs', w2c w)+{-# INLINE unsnoc #-}+ -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. head :: ByteString -> Char head = w2c . B.head@@ -997,17 +1007,17 @@ -- 'pack'.  It also may be more efficient than opening the file and -- reading it using hGet. readFile :: FilePath -> IO ByteString-readFile f = bracket (openFile f ReadMode) hClose+readFile f = bracket (openBinaryFile f ReadMode) hClose     (\h -> hFileSize h >>= hGet h . fromIntegral)  -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO ()-writeFile f txt = bracket (openFile f WriteMode) hClose+writeFile f txt = bracket (openBinaryFile f WriteMode) hClose     (\h -> hPut h txt)  -- | Append a 'ByteString' to a file. appendFile :: FilePath -> ByteString -> IO ()-appendFile f txt = bracket (openFile f AppendMode) hClose+appendFile f txt = bracket (openBinaryFile f AppendMode) hClose     (\h -> hPut h txt)  

@@ -35,9 +35,11 @@          -- * Low level imperative construction         create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString+        createUptoN,            -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString         createAndTrim,          -- :: Int -> (Ptr Word8 -> IO Int) -> IO  ByteString         createAndTrim',         -- :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)         unsafeCreate,           -- :: Int -> (Ptr Word8 -> IO ()) ->  ByteString+        unsafeCreateUptoN,      -- :: Int -> (Ptr Word8 -> IO Int) ->  ByteString         mallocByteString,       -- :: Int -> IO (ForeignPtr a)          -- * Conversion to and from ForeignPtrs@@ -240,7 +242,7 @@  packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) packUptoLenBytes len xs0 =-    unsafeDupablePerformIO $ create' len $ \p -> go p len xs0+    unsafeCreateUptoN' len $ \p -> go p len xs0   where     go !_ !n []     = return (len-n, [])     go !_ !0 xs     = return (len,   xs)@@ -248,7 +250,7 @@  packUptoLenChars :: Int -> [Char] -> (ByteString, [Char]) packUptoLenChars len cs0 =-    unsafeDupablePerformIO $ create' len $ \p -> go p len cs0+    unsafeCreateUptoN' len $ \p -> go p len cs0   where     go !_ !n []     = return (len-n, [])     go !_ !0 cs     = return (len,   cs)@@ -347,13 +349,23 @@ {-# INLINE toForeignPtr #-}  -- | A way of creating ByteStrings outside the IO monad. The @Int@--- argument gives the final size of the ByteString. Unlike--- 'createAndTrim' the ByteString is not reallocated if the final size--- is less than the estimated size.+-- argument gives the final size of the ByteString. unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString unsafeCreate l f = unsafeDupablePerformIO (create l f) {-# INLINE unsafeCreate #-} +-- | Like 'unsafeCreate' but instead of giving the final size of the+-- ByteString, it is just an upper bound. The inner action returns+-- the actual size. Unlike 'createAndTrim' the ByteString is not+-- reallocated if the final size is less than the estimated size.+unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString+unsafeCreateUptoN l f = unsafeDupablePerformIO (createUptoN l f)+{-# INLINE unsafeCreateUptoN #-}++unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)+unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)+{-# INLINE unsafeCreateUptoN' #-}+ #ifndef __GLASGOW_HASKELL__ -- for Hugs, NHC etc unsafeDupablePerformIO :: IO a -> a@@ -368,13 +380,22 @@     return $! PS fp 0 l {-# INLINE create #-} +-- | Create ByteString of up to size size @l@ and use action @f@ to fill it's+-- contents which returns its true size.+createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString+createUptoN l f = do+    fp <- mallocByteString l+    l' <- withForeignPtr fp $ \p -> f p+    assert (l' <= l) $ return $! PS fp 0 l'+{-# INLINE createUptoN #-}+ -- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.-create' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)-create' l f = do+createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)+createUptoN' l f = do     fp <- mallocByteString l     (l', res) <- withForeignPtr fp $ \p -> f p     assert (l' <= l) $ return (PS fp 0 l', res)-{-# INLINE create' #-}+{-# INLINE createUptoN' #-}  -- | Given the maximum size needed and a function to make the contents -- of a ByteString, createAndTrim makes the 'ByteString'. The generating

@@ -73,6 +73,7 @@         append,                 -- :: ByteString -> ByteString -> ByteString         head,                   -- :: ByteString -> Word8         uncons,                 -- :: ByteString -> Maybe (Word8, ByteString)+        unsnoc,                 -- :: ByteString -> Maybe (ByteString, Word8)         last,                   -- :: ByteString -> Word8         tail,                   -- :: ByteString -> ByteString         init,                   -- :: ByteString -> ByteString@@ -394,7 +395,7 @@ last :: ByteString -> Word8 last Empty          = errorEmptyList "last" last (Chunk c0 cs0) = go c0 cs0-  where go c Empty        = S.last c+  where go c Empty        = S.unsafeLast c         go _ (Chunk c cs) = go c cs -- XXX Don't inline this. Something breaks with 6.8.2 (haven't investigated yet) @@ -403,9 +404,17 @@ init Empty          = errorEmptyList "init" init (Chunk c0 cs0) = go c0 cs0   where go c Empty | S.length c == 1 = Empty-                   | otherwise       = Chunk (S.init c) Empty+                   | otherwise       = Chunk (S.unsafeInit c) Empty         go c (Chunk c' cs)           = Chunk c (go c' cs) +-- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning Nothing+-- if it is empty.+--+-- * It is no faster than using 'init' and 'last'+unsnoc :: ByteString -> Maybe (ByteString, Word8)+unsnoc Empty        = Nothing+unsnoc (Chunk c cs) = Just (init (Chunk c cs), last (Chunk c cs))+ -- | /O(n\/c)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString append = mappend@@ -482,6 +491,7 @@  -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'.+-- This function is subject to array fusion. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 _ Empty        = errorEmptyList "foldl1" foldl1 f (Chunk c cs) = foldl f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs)

@@ -1,451 +1,11 @@-{-# LANGUAGE CPP, BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{- | Copyright   : (c) 2010 Jasper Van der Jeugt-                   (c) 2010 - 2011 Simon Meier-License     : BSD3-style (see LICENSE)-Maintainer  : Simon Meier <iridcode@gmail.com>-Portability : GHC -'Builder's are used to efficiently construct sequences of bytes from-  smaller parts.-Typically,-  such a construction is part of the implementation of an /encoding/, i.e.,-  a function for converting Haskell values to sequences of bytes.-Examples of encodings are the generation of the sequence of bytes-  representing a HTML document to be sent in a HTTP response by a-  web application or the serialization of a Haskell value using-  a fixed binary format.--For an /efficient implementation of an encoding/,-  it is important that (a) little time is spent on converting-  the Haskell values to the resulting sequence of bytes /and/-  (b) that the representation of the resulting sequence-  is such that it can be consumed efficiently.-'Builder's support (a) by providing an /O(1)/ concatentation operation-  and efficient implementations of basic encodings for 'Char's, 'Int's,-  and other standard Haskell values.-They support (b) by providing their result as a lazy 'L.ByteString',-  which is internally just a linked list of pointers to /chunks/-  of consecutive raw memory.-Lazy 'L.ByteString's can be efficiently consumed by functions that-  write them to a file or send them over a network socket.-Note that each chunk boundary incurs expensive extra work (e.g., a system call)-  that must be amortized over the work spent on consuming the chunk body.-'Builder's therefore take special care to ensure that the-  average chunk size is large enough.-The precise meaning of large enough is application dependent.-The current implementation is tuned-  for an average chunk size between 4kb and 32kb,-  which should suit most applications.--As a simple example of an encoding implementation,-  we show how to efficiently convert the following representation of mixed-data-  tables to an UTF-8 encoded Comma-Separated-Values (CSV) table.-->data Cell = StringC String->          | IntC Int->          deriving( Eq, Ord, Show )->->type Row   = [Cell]->type Table = [Row]--We use the following imports and abbreviate 'mappend' to simplify reading.--@-import qualified "Data.ByteString.Lazy"               as L-import           "Data.ByteString.Lazy.Builder"-import           "Data.ByteString.Lazy.Builder.ASCII" ('intDec')-import           Data.Monoid-import           Data.Foldable                        ('foldMap')-import           Data.List                            ('intersperse')--infixr 4 \<\>-(\<\>) :: 'Monoid' m => m -> m -> m-(\<\>) = 'mappend'-@--CSV is a character-based representation of tables. For maximal modularity,-we could first render 'Table's as 'String's and then encode this 'String'-using some Unicode character encoding. However, this sacrifices performance-due to the intermediate 'String' representation being built and thrown away-right afterwards. We get rid of this intermediate 'String' representation by-fixing the character encoding to UTF-8 and using 'Builder's to convert-'Table's directly to UTF-8 encoded CSV tables represented as lazy-'L.ByteString's.--@-encodeUtf8CSV :: Table -> L.ByteString-encodeUtf8CSV = 'toLazyByteString' . renderTable--renderTable :: Table -> Builder-renderTable rs = 'mconcat' [renderRow r \<\> 'charUtf8' \'\\n\' | r <- rs]--renderRow :: Row -> Builder-renderRow []     = 'mempty'-renderRow (c:cs) =-    renderCell c \<\> mconcat [ charUtf8 \',\' \<\> renderCell c\' | c\' <- cs ]--renderCell :: Cell -> Builder-renderCell (StringC cs) = renderString cs-renderCell (IntC i)     = 'intDec' i--renderString :: String -> Builder-renderString cs = charUtf8 \'\"\' \<\> foldMap escape cs \<\> charUtf8 \'\"\'-  where-    escape \'\\\\\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\\\'-    escape \'\\\"\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\"\'-    escape c    = charUtf8 c-@--Note that the ASCII encoding is a subset of the UTF-8 encoding,-  which is why we can use the optimized function 'intDec' to-  encode an 'Int' as a decimal number with UTF-8 encoded digits.-Using 'intDec' is more efficient than @'stringUtf8' . 'show'@,-  as it avoids constructing an intermediate 'String'.-Avoiding this intermediate data structure significantly improves-  performance because encoding 'Cell's is the core operation-  for rendering CSV-tables.-See "Data.ByteString.Lazy.Builder.BasicEncoding" for further-  information on how to improve the performance of 'renderString'.--We demonstrate our UTF-8 CSV encoding function on the following table.--@-strings :: [String]-strings =  [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]--table :: Table-table = [map StringC strings, map IntC [-3..3]]-@--The expression @encodeUtf8CSV table@ results in the following lazy-'L.ByteString'.-->Chunk "\"hello\",\"\\\"1\\\"\",\"\206\187-w\195\182rld\"\n-3,-2,-1,0,1,2,3\n" Empty--We can clearly see that we are converting to a /binary/ format. The \'&#955;\'-and \'&#246;\' characters, which have a Unicode codepoint above 127, are-expanded to their corresponding UTF-8 multi-byte representation.--We use the @criterion@ library (<http://hackage.haskell.org/package/criterion>)-  to benchmark the efficiency of our encoding function on the following table.-->import Criterion.Main     -- add this import to the ones above->->maxiTable :: Table->maxiTable = take 1000 $ cycle table->->main :: IO ()->main = defaultMain->  [ bench "encodeUtf8CSV maxiTable (original)" $->      whnf (L.length . encodeUtf8CSV) maxiTable->  ]--On a Core2 Duo 2.20GHz on a 32-bit Linux,-  the above code takes 1ms to generate the 22'500 bytes long lazy 'L.ByteString'.-Looking again at the definitions above,-  we see that we took care to avoid intermediate data structures,-  as otherwise we would sacrifice performance.-For example,-  the following (arguably simpler) definition of 'renderRow' is about 20% slower.-->renderRow :: Row -> Builder->renderRow  = mconcat . intersperse (charUtf8 ',') . map renderCell--Similarly, using /O(n)/ concatentations like '++' or the equivalent 'S.concat'-  operations on strict and lazy 'L.ByteString's should be avoided.-The following definition of 'renderString' is also about 20% slower.-->renderString :: String -> Builder->renderString cs = charUtf8 $ "\"" ++ concatMap escape cs ++ "\""->  where->    escape '\\' = "\\"->    escape '\"' = "\\\""->    escape c    = return c--Apart from removing intermediate data-structures,-  encodings can be optimized further by fine-tuning their execution-  parameters using the functions in "Data.ByteString.Lazy.Builder.Extras" and-  their \"inner loops\" using the functions in-  "Data.ByteString.Lazy.Builder.BasicEncoding".--}---module Data.ByteString.Lazy.Builder-    (-      -- * The Builder type-      Builder--      -- * Executing Builders-      -- | Internally, 'Builder's are buffer-filling functions. They are-      -- executed by a /driver/ that provides them with an actual buffer to-      -- fill. Once called with a buffer, a 'Builder' fills it and returns a-      -- signal to the driver telling it that it is either done, has filled the-      -- current buffer, or wants to directly insert a reference to a chunk of-      -- memory. In the last two cases, the 'Builder' also returns a-      -- continutation 'Builder' that the driver can call to fill the next-      -- buffer. Here, we provide the two drivers that satisfy almost all use-      -- cases. See "Data.ByteString.Lazy.Builder.Extras", for information-      -- about fine-tuning them.-    , toLazyByteString-    , hPutBuilder--      -- * Creating Builders--      -- ** Binary encodings-    , byteString-    , lazyByteString-    , int8-    , word8--      -- *** Big-endian-    , int16BE-    , int32BE-    , int64BE--    , word16BE-    , word32BE-    , word64BE--    , floatBE-    , doubleBE--      -- *** Little-endian-    , int16LE-    , int32LE-    , int64LE--    , word16LE-    , word32LE-    , word64LE--    , floatLE-    , doubleLE--    -- ** Character encodings--    -- *** ASCII (Char7)-    -- | The ASCII encoding is a 7-bit encoding. The /Char7/ encoding implemented here-    -- works by truncating the Unicode codepoint to 7-bits, prefixing it-    -- with a leading 0, and encoding the resulting 8-bits as a single byte.-    -- For the codepoints 0-127 this corresponds the ASCII encoding. In-    -- "Data.ByteString.Lazy.Builder.ASCII", we also provide efficient-    -- implementations of ASCII-based encodings of numbers (e.g., decimal and-    -- hexadecimal encodings).-    , char7-    , string7--    -- *** ISO/IEC 8859-1 (Char8)-    -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.-    -- The /Char8/ encoding implemented here works by truncating the Unicode codepoint-    -- to 8-bits and encoding them as a single byte. For the codepoints 0-255 this corresponds-    -- to the ISO/IEC 8859-1 encoding. Note that you can also use-    -- the functions from "Data.ByteString.Lazy.Builder.ASCII", as the ASCII encoding-    -- and ISO/IEC 8859-1 are equivalent on the codepoints 0-127.-    , char8-    , string8--    -- *** UTF-8-    -- | The UTF-8 encoding can encode /all/ Unicode codepoints. We recommend-    -- using it always for encoding 'Char's and 'String's unless an application-    -- really requires another encoding. Note that you can also use the-    -- functions from "Data.ByteString.Lazy.Builder.ASCII" for UTF-8 encoding,-    -- as the ASCII encoding is equivalent to the UTF-8 encoding on the Unicode-    -- codepoints 0-127.-    , charUtf8-    , stringUtf8---    ) where--import           Data.ByteString.Lazy.Builder.Internal-import qualified Data.ByteString.Lazy.Builder.BasicEncoding as E-import qualified Data.ByteString.Lazy.Internal as L--import           System.IO (Handle)-import           Foreign---- HADDOCK only imports-import           Data.ByteString.Lazy.Builder.ASCII (intDec)-import qualified Data.ByteString               as S (concat)-import           Data.Monoid-import           Data.Foldable                      (foldMap)-import           Data.List                          (intersperse)----- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'.--- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString'--- is forced.-{-# NOINLINE toLazyByteString #-} -- ensure code is shared-toLazyByteString :: Builder -> L.ByteString-toLazyByteString = toLazyByteStringWith-    (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty--{- Not yet stable enough.-   See note on 'hPut' in Data.ByteString.Lazy.Builder.Internal--}---- | Output a 'Builder' to a 'Handle'.--- The 'Builder' is executed directly on the buffer of the 'Handle'. If the--- buffer is too small (or not present), then it is replaced with a large--- enough buffer.------ It is recommended that the 'Handle' is set to binary and--- 'BlockBuffering' mode. See 'hSetBinaryMode' and 'hSetBuffering'.------ This function is more efficient than @hPut . 'toLazyByteString'@ because in--- many cases no buffer allocation has to be done. Moreover, the results of--- several executions of short 'Builder's are concatenated in the 'Handle's--- buffer, therefore avoiding unnecessary buffer flushes.-hPutBuilder :: Handle -> Builder -> IO ()-hPutBuilder h = hPut h . putBuilder------------------------------------------------------------------------------------ Binary encodings----------------------------------------------------------------------------------- | Encode a single signed byte as-is.+-- | We decided to rename the Builder modules. Sorry about that. ---{-# INLINE int8 #-}-int8 :: Int8 -> Builder-int8 = E.encodeWithF E.int8---- | Encode a single unsigned byte as-is.+-- The old names will hang about for at least once release cycle before we+-- deprecate them and then later remove them. ---{-# INLINE word8 #-}-word8 :: Word8 -> Builder-word8 = E.encodeWithF E.word8------------------------------------------------------------------------------------ Binary little-endian encodings----------------------------------------------------------------------------------- | Encode an 'Int16' in little endian format.-{-# INLINE int16LE #-}-int16LE :: Int16 -> Builder-int16LE = E.encodeWithF E.int16LE---- | Encode an 'Int32' in little endian format.-{-# INLINE int32LE #-}-int32LE :: Int32 -> Builder-int32LE = E.encodeWithF E.int32LE---- | Encode an 'Int64' in little endian format.-{-# INLINE int64LE #-}-int64LE :: Int64 -> Builder-int64LE = E.encodeWithF E.int64LE---- | Encode a 'Word16' in little endian format.-{-# INLINE word16LE #-}-word16LE :: Word16 -> Builder-word16LE = E.encodeWithF E.word16LE---- | Encode a 'Word32' in little endian format.-{-# INLINE word32LE #-}-word32LE :: Word32 -> Builder-word32LE = E.encodeWithF E.word32LE---- | Encode a 'Word64' in little endian format.-{-# INLINE word64LE #-}-word64LE :: Word64 -> Builder-word64LE = E.encodeWithF E.word64LE---- | Encode a 'Float' in little endian format.-{-# INLINE floatLE #-}-floatLE :: Float -> Builder-floatLE = E.encodeWithF E.floatLE---- | Encode a 'Double' in little endian format.-{-# INLINE doubleLE #-}-doubleLE :: Double -> Builder-doubleLE = E.encodeWithF E.doubleLE------------------------------------------------------------------------------------ Binary big-endian encodings----------------------------------------------------------------------------------- | Encode an 'Int16' in big endian format.-{-# INLINE int16BE #-}-int16BE :: Int16 -> Builder-int16BE = E.encodeWithF E.int16BE---- | Encode an 'Int32' in big endian format.-{-# INLINE int32BE #-}-int32BE :: Int32 -> Builder-int32BE = E.encodeWithF E.int32BE---- | Encode an 'Int64' in big endian format.-{-# INLINE int64BE #-}-int64BE :: Int64 -> Builder-int64BE = E.encodeWithF E.int64BE---- | Encode a 'Word16' in big endian format.-{-# INLINE word16BE #-}-word16BE :: Word16 -> Builder-word16BE = E.encodeWithF E.word16BE---- | Encode a 'Word32' in big endian format.-{-# INLINE word32BE #-}-word32BE :: Word32 -> Builder-word32BE = E.encodeWithF E.word32BE---- | Encode a 'Word64' in big endian format.-{-# INLINE word64BE #-}-word64BE :: Word64 -> Builder-word64BE = E.encodeWithF E.word64BE---- | Encode a 'Float' in big endian format.-{-# INLINE floatBE #-}-floatBE :: Float -> Builder-floatBE = E.encodeWithF E.floatBE---- | Encode a 'Double' in big endian format.-{-# INLINE doubleBE #-}-doubleBE :: Double -> Builder-doubleBE = E.encodeWithF E.doubleBE----------------------------------------------------------------------------------- ASCII encoding----------------------------------------------------------------------------------- | Char7 encode a 'Char'.-{-# INLINE char7 #-}-char7 :: Char -> Builder-char7 = E.encodeWithF E.char7---- | Char7 encode a 'String'.-{-# INLINE string7 #-}-string7 :: String -> Builder-string7 = E.encodeListWithF E.char7----------------------------------------------------------------------------------- ISO/IEC 8859-1 encoding----------------------------------------------------------------------------------- | Char8 encode a 'Char'.-{-# INLINE char8 #-}-char8 :: Char -> Builder-char8 = E.encodeWithF E.char8---- | Char8 encode a 'String'.-{-# INLINE string8 #-}-string8 :: String -> Builder-string8 = E.encodeListWithF E.char8----------------------------------------------------------------------------------- UTF-8 encoding----------------------------------------------------------------------------------- | UTF-8 encode a 'Char'.-{-# INLINE charUtf8 #-}-charUtf8 :: Char -> Builder-charUtf8 = E.encodeWithB E.charUtf8---- | UTF-8 encode a 'String'.-{-# INLINE stringUtf8 #-}-stringUtf8 :: String -> Builder-stringUtf8 = E.encodeListWithB E.charUtf8+module Data.ByteString.Lazy.Builder (+  module Data.ByteString.Builder+) where +import Data.ByteString.Builder

@@ -1,268 +1,14 @@-{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}--- | Copyright : (c) 2010 - 2011 Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Portability : GHC------ Constructing 'Builder's using ASCII-based encodings.----module Data.ByteString.Lazy.Builder.ASCII-    (-      -- * Decimal numbers-      -- | Decimal encoding of numbers using ASCII encoded characters.-      int8Dec-    , int16Dec-    , int32Dec-    , int64Dec-    , intDec-    , integerDec -    , word8Dec-    , word16Dec-    , word32Dec-    , word64Dec-    , wordDec--    , floatDec-    , doubleDec--      -- * Hexadecimal numbers--      -- | Encoding positive integers as hexadecimal numbers using lower-case-      -- ASCII characters. The shortest-      -- possible representation is used. For example,-      ---      -- >>> toLazyByteString (word16Hex 0x0a10)-      -- Chunk "a10" Empty-      ---      -- Note that there is no support for using upper-case characters. Please-      -- contact the maintainer, if your application cannot work without-      -- hexadecimal encodings that use upper-case characters.-      ---    , word8Hex-    , word16Hex-    , word32Hex-    , word64Hex-    , wordHex--      -- * Fixed-width hexadecimal numbers-      ---    , int8HexFixed-    , int16HexFixed-    , int32HexFixed-    , int64HexFixed-    , word8HexFixed-    , word16HexFixed-    , word32HexFixed-    , word64HexFixed--    , floatHexFixed-    , doubleHexFixed--    , byteStringHexFixed-    , lazyByteStringHexFixed--    ) where--import           Data.ByteString                                  as S-import           Data.ByteString.Lazy.Internal                    as L-import           Data.ByteString.Lazy.Builder.Internal (Builder)-import qualified Data.ByteString.Lazy.Builder.BasicEncoding       as E--import           Foreign----------------------------------------------------------------------------------- Decimal Encoding------------------------------------------------------------------------------------ | Encode a 'String' using 'E.char7'.-{-# INLINE string7 #-}-string7 :: String -> Builder-string7 = E.encodeListWithF E.char7----------------------------------------------------------------------------------- Decimal Encoding----------------------------------------------------------------------------------- Signed integers----------------------- | Decimal encoding of an 'Int8' using the ASCII digits.+-- | We decided to rename the Builder modules. Sorry about that. ----- e.g.+-- In additon, the ASCII module has been merged into the main+-- "Data.ByteString.Builder" module. ----- > toLazyByteString (int8Dec 42)   = "42"--- > toLazyByteString (int8Dec (-1)) = "-1"+-- The old names will hang about for at least once release cycle before we+-- deprecate them and then later remove them. ---{-# INLINE int8Dec #-}-int8Dec :: Int8 -> Builder-int8Dec = E.encodeWithB E.int8Dec---- | Decimal encoding of an 'Int16' using the ASCII digits.-{-# INLINE int16Dec #-}-int16Dec :: Int16 -> Builder-int16Dec = E.encodeWithB E.int16Dec---- | Decimal encoding of an 'Int32' using the ASCII digits.-{-# INLINE int32Dec #-}-int32Dec :: Int32 -> Builder-int32Dec = E.encodeWithB E.int32Dec---- | Decimal encoding of an 'Int64' using the ASCII digits.-{-# INLINE int64Dec #-}-int64Dec :: Int64 -> Builder-int64Dec = E.encodeWithB E.int64Dec---- | Decimal encoding of an 'Int' using the ASCII digits.-{-# INLINE intDec #-}-intDec :: Int -> Builder-intDec = E.encodeWithB E.intDec---- | /Currently slow./ Decimal encoding of an 'Integer' using the ASCII digits.-{-# INLINE integerDec #-}-integerDec :: Integer -> Builder-integerDec =  string7 . show----- Unsigned integers------------------------- | Decimal encoding of a 'Word8' using the ASCII digits.-{-# INLINE word8Dec #-}-word8Dec :: Word8 -> Builder-word8Dec = E.encodeWithB E.word8Dec---- | Decimal encoding of a 'Word16' using the ASCII digits.-{-# INLINE word16Dec #-}-word16Dec :: Word16 -> Builder-word16Dec = E.encodeWithB E.word16Dec---- | Decimal encoding of a 'Word32' using the ASCII digits.-{-# INLINE word32Dec #-}-word32Dec :: Word32 -> Builder-word32Dec = E.encodeWithB E.word32Dec---- | Decimal encoding of a 'Word64' using the ASCII digits.-{-# INLINE word64Dec #-}-word64Dec :: Word64 -> Builder-word64Dec = E.encodeWithB E.word64Dec---- | Decimal encoding of a 'Word' using the ASCII digits.-{-# INLINE wordDec #-}-wordDec :: Word -> Builder-wordDec = E.encodeWithB E.wordDec----- Floating point numbers------------------------------ TODO: Use Bryan O'Sullivan's double-conversion package to speed it up.---- | /Currently slow./ Decimal encoding of an IEEE 'Float'.-{-# INLINE floatDec #-}-floatDec :: Float -> Builder-floatDec = string7 . show---- | /Currently slow./ Decimal encoding of an IEEE 'Double'.-{-# INLINE doubleDec #-}-doubleDec :: Double -> Builder-doubleDec = string7 . show------------------------------------------------------------------------------------ Hexadecimal Encoding----------------------------------------------------------------------------------- without lead-------------------- | Shortest hexadecimal encoding of a 'Word8' using lower-case characters.-{-# INLINE word8Hex #-}-word8Hex :: Word8 -> Builder-word8Hex = E.encodeWithB E.word8Hex---- | Shortest hexadecimal encoding of a 'Word16' using lower-case characters.-{-# INLINE word16Hex #-}-word16Hex :: Word16 -> Builder-word16Hex = E.encodeWithB E.word16Hex---- | Shortest hexadecimal encoding of a 'Word32' using lower-case characters.-{-# INLINE word32Hex #-}-word32Hex :: Word32 -> Builder-word32Hex = E.encodeWithB E.word32Hex---- | Shortest hexadecimal encoding of a 'Word64' using lower-case characters.-{-# INLINE word64Hex #-}-word64Hex :: Word64 -> Builder-word64Hex = E.encodeWithB E.word64Hex---- | Shortest hexadecimal encoding of a 'Word' using lower-case characters.-{-# INLINE wordHex #-}-wordHex :: Word -> Builder-wordHex = E.encodeWithB E.wordHex----- fixed width; leading zeroes----------------------------------- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).-{-# INLINE int8HexFixed #-}-int8HexFixed :: Int8 -> Builder-int8HexFixed = E.encodeWithF E.int8HexFixed---- | Encode a 'Int16' using 4 nibbles.-{-# INLINE int16HexFixed #-}-int16HexFixed :: Int16 -> Builder-int16HexFixed = E.encodeWithF E.int16HexFixed---- | Encode a 'Int32' using 8 nibbles.-{-# INLINE int32HexFixed #-}-int32HexFixed :: Int32 -> Builder-int32HexFixed = E.encodeWithF E.int32HexFixed---- | Encode a 'Int64' using 16 nibbles.-{-# INLINE int64HexFixed #-}-int64HexFixed :: Int64 -> Builder-int64HexFixed = E.encodeWithF E.int64HexFixed---- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).-{-# INLINE word8HexFixed #-}-word8HexFixed :: Word8 -> Builder-word8HexFixed = E.encodeWithF E.word8HexFixed---- | Encode a 'Word16' using 4 nibbles.-{-# INLINE word16HexFixed #-}-word16HexFixed :: Word16 -> Builder-word16HexFixed = E.encodeWithF E.word16HexFixed---- | Encode a 'Word32' using 8 nibbles.-{-# INLINE word32HexFixed #-}-word32HexFixed :: Word32 -> Builder-word32HexFixed = E.encodeWithF E.word32HexFixed---- | Encode a 'Word64' using 16 nibbles.-{-# INLINE word64HexFixed #-}-word64HexFixed :: Word64 -> Builder-word64HexFixed = E.encodeWithF E.word64HexFixed---- | Encode an IEEE 'Float' using 8 nibbles.-{-# INLINE floatHexFixed #-}-floatHexFixed :: Float -> Builder-floatHexFixed = E.encodeWithF E.floatHexFixed---- | Encode an IEEE 'Double' using 16 nibbles.-{-# INLINE doubleHexFixed #-}-doubleHexFixed :: Double -> Builder-doubleHexFixed = E.encodeWithF E.doubleHexFixed---- | Encode each byte of a 'S.ByteString' using its fixed-width hex encoding.-{-# NOINLINE byteStringHexFixed #-} -- share code-byteStringHexFixed :: S.ByteString -> Builder-byteStringHexFixed = E.encodeByteStringWithF E.word8HexFixed+module Data.ByteString.Lazy.Builder.ASCII (+  module Data.ByteString.Builder+) where --- | Encode each byte of a lazy 'L.ByteString' using its fixed-width hex encoding.-{-# NOINLINE lazyByteStringHexFixed #-} -- share code-lazyByteStringHexFixed :: L.ByteString -> Builder-lazyByteStringHexFixed = E.encodeLazyByteStringWithF E.word8HexFixed+import Data.ByteString.Builder

@@ -1,804 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{- | Copyright : (c) 2010-2011 Simon Meier-                   (c) 2010      Jasper van der Jeugt-License        : BSD3-style (see LICENSE)-Maintainer     : Simon Meier <iridcode@gmail.com>-Portability    : GHC--This module provides the types of fixed-size and bounded-size encodings,-  which are the basic building blocks for constructing 'Builder's.-These types are used to achieve-  application-specific performance improvements of 'Builder's.--/Fixed(-size) encodings/ are encodings that always result in a sequence of bytes-  of a predetermined, fixed length.-An example for a fixed encoding is the big-endian encoding of a 'Word64',-  which always results in exactly 8 bytes.-/Bounded(-size) encodings/ are encodings that always result in a sequence-  of bytes that is no larger than a predetermined bound.-An example for a bounded encoding is the UTF-8 encoding of a 'Char',-  which results always in less or equal to 4 bytes.-Note that every fixed encoding is also a bounded encoding.-In the following, we therefore only refer to fixed encodings,-  where it matters that the resulting sequence of bytes is of a-  of a predetermined, fixed length.-Otherwise, we just refer to bounded encodings.--As said,-  the goal of bounded encodings is to improve the performance of 'Builder's.-These improvements stem from making the two-  most common steps performed by a 'Builder' more efficient.-We explain these two steps in turn.--The first most common step is the concatentation of two 'Builder's.-Internally,-  concatentation corresponds to function composition.-(Note that 'Builder's can be seen as difference-lists-  of buffer-filling functions;-  cf.  <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dlist>.-)-Function composition is a fast /O(1)/ operation.-However,-  we can use bounded encodings to-  remove some of these function compositions altoghether,-  which is obviously more efficient.--The second most common step performed by a 'Builder' is to fill a buffer-  using a bounded encoding,-  which works as follows.-The 'Builder' checks whether there is enough space left to-  execute the bounded encoding.-If there is, then the 'Builder' executes the bounded encoding-  and calls the next 'Builder' with the updated buffer.-Otherwise,-  the 'Builder' signals its driver that it requires a new buffer.-This buffer must be at least as large as the bound of the encoding.-We can use bounded encodings to reduce the number of buffer-free-  checks by fusing the buffer-free checks of consecutive-  'Builder's.-We can also use bounded encodings to simplify the control flow-  for signalling that a buffer is full by-  ensuring that we check first that there is enough space left-  and only then decide on how to encode a given value.--Let us illustrate these improvements on the-  CSV-table rendering example from "Data.ByteString.Lazy.Builder".-Its \"hot code\" is the rendering of a table's cells,-  which we implement as follows using only the functions from the-  'Builder' API.--@-import           "Data.ByteString.Lazy.Builder"         as B-import           "Data.ByteString.Lazy.Builder.ASCII"   as B--renderCell :: Cell -> Builder-renderCell (StringC cs) = renderString cs-renderCell (IntC i)     = B.intDec i--renderString :: String -> Builder-renderString cs = B.charUtf8 \'\"\' \<\> foldMap escape cs \<\> B.charUtf8 \'\"\'-  where-    escape \'\\\\\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\\\'-    escape \'\\\"\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\"\'-    escape c    = B.charUtf8 c-@--Efficient encoding of 'Int's as decimal numbers is performed by @intDec@-  from "Data.ByteString.Lazy.Builder.ASCII".-Optimization potential exists for the escaping of 'String's.-The above implementation has two optimization opportunities.-First,-  the buffer-free checks of the 'Builder's for escaping doublequotes-  and backslashes can be fused.-Second,-  the concatenations performed by 'foldMap' can be eliminated.-The following implementation exploits these optimizations.--@-import qualified Data.ByteString.Lazy.Builder.BasicEncoding  as E-import           Data.ByteString.Lazy.Builder.BasicEncoding-                 ( 'ifB', 'fromF', ('>*<'), ('>$<') )--renderString :: String -\> Builder-renderString cs =-    B.charUtf8 \'\"\' \<\> E.'encodeListWithB' escape cs \<\> B.charUtf8 \'\"\'-  where-    escape :: E.'BoundedEncoding' Char-    escape =-      'ifB' (== \'\\\\\') (fixed2 (\'\\\\\', \'\\\\\')) $-      'ifB' (== \'\\\"\') (fixed2 (\'\\\\\', \'\\\"\')) $-      E.'charUtf8'-    &#160;-    {&#45;\# INLINE fixed2 \#&#45;}-    fixed2 x = 'fromF' $ const x '>$<' E.'char7' '>*<' E.'char7'-@--The code should be mostly self-explanatory.-The slightly awkward syntax is because the combinators-  are written such that the size-bound of the resulting 'BoundedEncoding'-  can be computed at compile time.-We also explicitly inline the 'fixed2' encoding,-  which encodes a fixed tuple of characters,-  to ensure that the bound compuation happens at compile time.-When encoding the following list of 'String's,-  the optimized implementation of 'renderString' is two times faster.--@-maxiStrings :: [String]-maxiStrings = take 1000 $ cycle [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]-@--Most of the performance gain stems from using 'encodeListWithB',-  which encodes a list of values from left-to-right with a-  'BoundedEncoding'.-It exploits the 'Builder' internals to avoid unnecessary function-  compositions (i.e., concatentations).-In the future,-  we would expect the compiler to perform the optimizations-  implemented in 'encodeListWithB'.-However,-  it seems that the code is currently to complicated for the-  compiler to see through.-Therefore,-  we provide the 'BoundedEncoding' escape hatch,-  which allows data structures to provide very efficient encoding traversals,-  like 'encodeListWithB' for lists.--Note that 'BoundedEncoding's are a bit verbose, but quite versatile.-Here is an example of a 'BoundedEncoding' for combined HTML escapng and-UTF-8 encoding.-It exploits that the escaped character with the maximal Unicode-  codepoint is \'>\'.--@-{&#45;\# INLINE charUtf8HtmlEscaped \#&#45;}-charUtf8HtmlEscaped :: E.BoundedEncoding Char-charUtf8HtmlEscaped =-    'ifB' (>  \'\>\' ) E.'charUtf8' $-    'ifB' (== \'\<\' ) (fixed4 (\'&\',(\'l\',(\'t\',\';\')))) $        -- &lt;-    'ifB' (== \'\>\' ) (fixed4 (\'&\',(\'g\',(\'t\',\';\')))) $        -- &gt;-    'ifB' (== \'&\' ) (fixed5 (\'&\',(\'a\',(\'m\',(\'p\',\';\'))))) $  -- &amp;-    'ifB' (== \'\"\' ) (fixed5 (\'&\',(\'\#\',(\'3\',(\'4\',\';\'))))) $  -- &\#34;-    'ifB' (== \'\\\'\') (fixed5 (\'&\',(\'\#\',(\'3\',(\'9\',\';\'))))) $  -- &\#39;-    ('fromF' E.'char7')         -- fallback for 'Char's smaller than \'\>\'-  where-    {&#45;\# INLINE fixed4 \#&#45;}-    fixed4 x = 'fromF' $ const x '>$<'-      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7-    &#160;-    {&#45;\# INLINE fixed5 \#&#45;}-    fixed5 x = 'fromF' $ const x '>$<'-      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7-@--This module currently does not expose functions that require the special-  properties of fixed-size encodings.-They are useful for prefixing 'Builder's with their size or for-  implementing chunked encodings.-We will expose the corresponding functions in future releases of this-  library.--}----{---------- A /bounded encoding/ is an encoding that never results in a sequence--- longer than some fixed number of bytes. This number of bytes must be--- independent of the value being encoded. Typical examples of bounded--- encodings are the big-endian encoding of a 'Word64', which results always--- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always--- in less or equal to 4 bytes.------ Typically, encodings are implemented efficiently by allocating a buffer (an--- array of bytes) and repeatedly executing the following two steps: (1)--- writing to the buffer until it is full and (2) handing over the filled part--- to the consumer of the encoded value. Step (1) is where bounded encodings--- are used. We must use a bounded encoding, as we must check that there is--- enough free space /before/ actually writing to the buffer.------ In term of expressivity, it would be sufficient to construct all encodings--- from the single bounded encoding that encodes a 'Word8' as-is. However,--- this is not sufficient in terms of efficiency. It results in unnecessary--- buffer-full checks and it complicates the program-flow for writing to the--- buffer, as buffer-full checks are interleaved with analyzing the value to be--- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a--- significant effect on overall encoding performance, as encoding primitive--- Haskell values such as 'Word8's or 'Char's lies at the heart of every--- encoding implementation.------ The bounded 'Encoding's provided by this module remove this performance--- problem. Intuitively, they consist of a tuple of the bound on the maximal--- number of bytes written and the actual implementation of the encoding as a--- function that modifies a mutable buffer. Hence when executing a bounded--- 'Encoding', the buffer-full check can be done once before the actual writing--- to the buffer. The provided 'Encoding's also take care to implement the--- actual writing to the buffer efficiently. Moreover, combinators are--- provided to construct new bounded encodings from the provided ones.------ A typical example for using the combinators is a bounded 'Encoding' that--- combines escaping the ' and \\ characters with UTF-8 encoding. More--- precisely, the escaping to be done is the one implemented by the following--- @escape@ function.------ > escape :: Char -> [Char]--- > escape '\'' = "\\'"--- > escape '\\' = "\\\\"--- > escape c    = [c]------ The bounded 'Encoding' that combines this escaping with UTF-8 encoding is--- the following.------ > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)--- >--- > {-# INLINE escapeChar #-}--- > escapeUtf8 :: BoundedEncoding Char--- > escapeUtf8 =--- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $--- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $--- >     char------ The definition of 'escapeUtf8' is more complicated than 'escape', because--- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in--- 'escapeChar' compute both the bound on the maximal number of bytes written--- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required--- to implement the encoding. Bounded 'Encoding's should always be inlined.--- Otherwise, the compiler cannot compute the bound on the maximal number of--- bytes written at compile-time. Without inlinining, it would also fail to--- optimize the constant encoding of the escape characters in the above--- example. Functions that execute bounded 'Encoding's also perform--- suboptimally, if the definition of the bounded 'Encoding' is not inlined.--- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.------ Currently, the only library that executes bounded 'Encoding's is the--- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It--- uses bounded 'Encoding's to implement most of its lazy bytestring builders.--- Executing a bounded encoding should be done using the corresponding--- functions in the lazy bytestring builder 'Extras' module.------ TODO: Merge with explanation/example below------ Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by--- writing a bounded-size sequence of bytes directly to memory. They are--- lifted to conversions from Haskell values to 'Builder's by wrapping them--- with a bound-check. The compiler can implement this bound-check very--- efficiently (i.e, a single comparison of the difference of two pointers to a--- constant), because the bound of a 'E.Encoding' is always independent of the--- value being encoded and, in most cases, a literal constant.------ 'E.Encoding's are the primary means for defining conversion functions from--- primitive Haskell values to 'Builder's. Most 'Builder' constructors--- provided by this library are implemented that way.--- 'E.Encoding's are also used to construct conversions that exploit the internal--- representation of data-structures.------ For example, 'encodeByteStringWith' works directly on the underlying byte--- array and uses some tricks to reduce the number of variables in its inner--- loop. Its efficiency is exploited for implementing the @filter@ and @map@--- functions in "Data.ByteString.Lazy" as------ > import qualified Codec.Bounded.Encoding as E--- >--- > filter :: (Word8 -> Bool) -> ByteString -> ByteString--- > filter p = toLazyByteString . encodeLazyByteStringWithB write--- >   where--- >     write = E.encodeIf p E.word8 E.emptyEncoding--- >--- > map :: (Word8 -> Word8) -> ByteString -> ByteString--- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)------ Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,--- these versions use a more efficient inner loop and have the additional--- advantage that they always result in well-chunked 'L.ByteString's; i.e, they--- also perform automatic defragmentation.------ We can also use 'E.Encoding's to improve the efficiency of the following--- 'renderString' function from our UTF-8 CSV table encoding example in--- "Data.ByteString.Lazy.Builder".------ > renderString :: String -> Builder--- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'--- >   where--- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'--- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'--- >     escape c    = charUtf8 c------ The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes--- characters and using 'encodeListWith', which implements writing a list of--- values with a tighter inner loop and no 'mappend'.------ > import Data.ByteString.Lazy.Builder.Extras     -- assume these three--- > import Codec.Bounded.Encoding                  -- imports are present--- >        ( BoundedEncoding, encodeIf, (<#>), (#.) )--- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)--- >--- > renderString :: String -> Builder--- > renderString cs =--- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'--- >   where--- >     escapedUtf8 :: BoundedEncoding Char--- >     escapedUtf8 =--- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $--- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $--- >       char------ This 'Builder' considers a buffer with less than 8 free bytes as full. As--- all functions are inlined, the compiler is able to optimize the constant--- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of--- 'renderString' this implementation is 1.7x faster.-----}-{--Internally, 'Builder's are buffer-fill operations that are-given a continuation buffer-fill operation and a buffer-range to be filled.-A 'Builder' first checks if the buffer-range is large enough. If that's-the case, the 'Builder' writes the sequences of bytes to the buffer and-calls its continuation.  Otherwise, it returns a signal that it requires a-new buffer together with a continuation to be called on this new buffer.-Ignoring the rare case of a full buffer-range, the execution cost of a-'Builder' consists of three parts:--  1. The time taken to read the parameters; i.e., the buffer-fill-     operation to call after the 'Builder' is done and the buffer-range to-     fill.--  2. The time taken to check for the size of the buffer-range.--  3. The time taken for the actual encoding.--We can reduce cost (1) by ensuring that fewer buffer-fill function calls are-required. We can reduce cost (2) by fusing buffer-size checks of sequential-writes. For example, when escaping a 'String' using 'renderString', it would-be sufficient to check before encoding a character that at least 8 bytes are-free. We can reduce cost (3) by implementing better primitive 'Builder's.-For example, 'renderCell' builds an intermediate list containing the decimal-representation of an 'Int'. Implementing a direct decimal encoding of 'Int's-to memory would be more efficient, as it requires fewer buffer-size checks-and less allocation. It is also a planned extension of this library.--The first two cost reductions are supported for user code through functions-in "Data.ByteString.Lazy.Builder.Extras". There, we continue the above example-and drop the generation time to 0.8ms by implementing 'renderString' more-cleverly. The third reduction requires meddling with the internals of-'Builder's and is not recomended in code outside of this library. However,-patches to this library are very welcome.--}-module Data.ByteString.Lazy.Builder.BasicEncoding (--  -- * Fixed-size encodings-    FixedEncoding--  -- ** Combinators-  -- | The combinators for 'FixedEncoding's are implemented such that the 'size'-  -- of the resulting 'FixedEncoding' is computed at compile time.-  , emptyF-  , pairF-  , contramapF--  -- ** Builder construction-  -- | In terms of expressivity, the function 'encodeWithF' would be sufficient-  -- for constructing 'Builder's from 'FixedEncoding's. The fused variants of-  -- this function are provided because they allow for more efficient-  -- implementations. Our compilers are just not smart enough yet; and for some-  -- of the employed optimizations (see the code of 'encodeByteStringWithF')-  -- they will very likely never be.-  ---  -- Note that functions marked with \"/Heavy inlining./\" are forced to be-  -- inlined because they must be specialized for concrete encodings,-  -- but are rather heavy in terms of code size. We recommend to define a-  -- top-level function for every concrete instantiation of such a function in-  -- order to share its code. A typical example is the function-  -- 'byteStringHexFixed' from "Data.ByteString.Lazy.Builder.ASCII", which is-  -- implemented as follows.-  ---  -- @-  -- byteStringHexFixed :: S.ByteString -> Builder-  -- byteStringHexFixed = 'encodeByteStringWithF' 'word8HexFixed'-  -- @-  ---  , encodeWithF-  , encodeListWithF-  , encodeUnfoldrWithF--  , encodeByteStringWithF-  , encodeLazyByteStringWithF--  -- * Bounded-size encodings--  , BoundedEncoding--  -- ** Combinators-  -- | The combinators for 'BoundedEncoding's are implemented such that the-  -- 'sizeBound' of the resulting 'BoundedEncoding' is computed at compile time.-  , fromF-  , emptyB-  , pairB-  , eitherB-  , ifB-  , contramapB--  -- | We provide overloaded operators for some of the above combinators to-  -- allow for a more convenient syntax. We do not export their corresponding,-  -- as we they are used for overloading only and should not be extended by-  -- the user of this library. We plan to use the @contravariant@ library-  -- <http://hackage.haskell.org/package/contravariant> once it is part of the-  -- Haskell platform.-  , (>*<)-  , (>$<)--  -- ** Builder construction-  , encodeWithB-  , encodeListWithB-  , encodeUnfoldrWithB--  , encodeByteStringWithB-  , encodeLazyByteStringWithB--  -- * Standard encodings of Haskell values--  , module Data.ByteString.Lazy.Builder.BasicEncoding.Binary--  -- ** Character encodings-  , module Data.ByteString.Lazy.Builder.BasicEncoding.ASCII--  -- *** ISO/IEC 8859-1 (Char8)-  -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.-  -- The /Char8/ encoding implemented here works by truncating the Unicode-  -- codepoint to 8-bits and encoding them as a single byte. For the codepoints-  -- 0-255 this corresponds to the ISO/IEC 8859-1 encoding. Note that the-  -- Char8 encoding is equivalent to the ASCII encoding on the Unicode-  -- codepoints 0-127. Hence, functions such as 'intDec' can also be used for-  -- encoding 'Int's as a decimal number with Char8 encoded characters.-  , char8--  -- *** UTF-8-  -- | The UTF-8 encoding can encode all Unicode codepoints.-  -- It is equivalent to the ASCII encoding on the Unicode codepoints 0-127.-  -- Hence, functions such as 'intDec' can also be used for encoding 'Int's as-  -- a decimal number with UTF-8 encoded characters.-  , charUtf8--  -- * Testing support-  -- | The following four functions are intended for testing use-  -- only. They are /not/ efficient. Basic encodings are efficently executed by-  -- creating 'Builder's from them using the @encodeXXX@ functions explained at-  -- the top of this module.--  , evalF-  , evalB--  , showF-  , showB--  ) where--import           Data.ByteString.Lazy.Builder.Internal-import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts-import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16 (lowerTable, encode4_as_8)--import qualified Data.ByteString               as S-import qualified Data.ByteString.Internal      as S-import qualified Data.ByteString.Lazy.Internal as L--import           Data.Monoid-import           Data.List (unfoldr)  -- HADDOCK ONLY-import           Data.Char (chr, ord)-import           Control.Monad ((<=<), unless)--import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal hiding (size, sizeBound)-import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as I (size, sizeBound)-import           Data.ByteString.Lazy.Builder.BasicEncoding.Binary-import           Data.ByteString.Lazy.Builder.BasicEncoding.ASCII--#if MIN_VERSION_base(4,4,0)-import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)-import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import           System.IO.Unsafe (unsafePerformIO)-#else-import           Foreign-#endif----------------------------------------------------------------------------------- Creating Builders from bounded encodings----------------------------------------------------------------------------------- | Encode a value with a 'FixedEncoding'.-{-# INLINE encodeWithF #-}-encodeWithF :: FixedEncoding a -> (a -> Builder)-encodeWithF = encodeWithB . toB---- | Encode a list of values from left-to-right with a 'FixedEncoding'.-{-# INLINE encodeListWithF #-}-encodeListWithF :: FixedEncoding a -> ([a] -> Builder)-encodeListWithF = encodeListWithB . toB---- | Encode a list of values represented as an 'unfoldr' with a 'FixedEncoding'.-{-# INLINE encodeUnfoldrWithF #-}-encodeUnfoldrWithF :: FixedEncoding b -> (a -> Maybe (b, a)) -> a -> Builder-encodeUnfoldrWithF = encodeUnfoldrWithB . toB---- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from--- left-to-right with a 'FixedEncoding'. This function is quite versatile. For--- example, we can use it to construct a 'Builder' that maps every byte before--- copying it to the buffer to be filled.------ > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder--- > mapToBuilder f = encodeByteStringWithF (contramapF f word8)------ We can also use it to hex-encode a strict 'S.ByteString' as shown by the--- 'byteStringHexFixed' example above.-{-# INLINE encodeByteStringWithF #-}-encodeByteStringWithF :: FixedEncoding Word8 -> (S.ByteString -> Builder)-encodeByteStringWithF = encodeByteStringWithB . toB---- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from--- left-to-right with a 'FixedEncoding'.-{-# INLINE encodeLazyByteStringWithF #-}-encodeLazyByteStringWithF :: FixedEncoding Word8 -> (L.ByteString -> Builder)-encodeLazyByteStringWithF = encodeLazyByteStringWithB . toB---- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build--- fusion. Its performance relies on hoisting several variables out of the--- inner loop.  That's not possible when writing 'encodeListWith' as a 'foldr'.--- If we had stream fusion for lists, then we could fuse 'encodeListWith', as--- 'encodeWithStream' can keep control over the execution.----- | Create a 'Builder' that encodes values with the given 'Encoding'.------ We rewrite consecutive uses of 'encodeWith' such that the bound-checks are--- fused. For example,------ > encodeWithB (word32 c1) `mappend` encodeWithB (word32 c2)------ is rewritten such that the resulting 'Builder' checks only once, if ther are--- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This--- optimization is not observationally equivalent in a strict sense, as it--- influences the boundaries of the generated chunks. However, for a user of--- this library it is observationally equivalent, as chunk boundaries of a lazy--- 'L.ByteString' can only be observed through the internal interface.--- Morevoer, we expect that all 'Encoding's write much fewer than 4kb (the--- default short buffer size). Hence, it is safe to ignore the additional--- memory spilled due to the more agressive buffer wrapping introduced by this--- optimization.----{-# INLINE[1] encodeWithB #-}-encodeWithB :: BoundedEncoding a -> (a -> Builder)-encodeWithB w =-    mkBuilder-  where-    bound = I.sizeBound w-    mkBuilder x = builder step-      where-        step k (BufferRange op ope)-          | op `plusPtr` bound <= ope = do-              op' <- runB w x op-              let !br' = BufferRange op' ope-              k br'-          | otherwise = return $ bufferFull bound op (step k)--{-# RULES--"append/encodeWithB" forall w1 w2 x1 x2.-       append (encodeWithB w1 x1) (encodeWithB w2 x2)-     = encodeWithB (pairB w1 w2) (x1, x2)--"append/encodeWithB/assoc_r" forall w1 w2 x1 x2 b.-       append (encodeWithB w1 x1) (append (encodeWithB w2 x2) b)-     = append (encodeWithB (pairB w1 w2) (x1, x2)) b--"append/encodeWithB/assoc_l" forall w1 w2 x1 x2 b.-       append (append b (encodeWithB w1 x1)) (encodeWithB w2 x2)-     = append b (encodeWithB (pairB w1 w2) (x1, x2))-  #-}---- TODO: The same rules for 'putBuilder (..) >> putBuilder (..)'---- | Create a 'Builder' that encodes a list of values consecutively using an--- 'Encoding'. This function is more efficient than the canonical------ > filter p =--- >  B.toLazyByteString .--- >  E.encodeLazyByteStringWithF (E.ifF p E.word8) E.emptyF)--- >------ > mconcat . map (encodeWithB w)------ or------ > foldMap (encodeWithB w)------ because it moves several variables out of the inner loop.-{-# INLINE encodeListWithB #-}-encodeListWithB :: BoundedEncoding a -> [a] -> Builder-encodeListWithB w =-    makeBuilder-  where-    bound = I.sizeBound w-    makeBuilder xs0 = builder $ step xs0-      where-        step xs1 k !(BufferRange op0 ope0) = go xs1 op0-          where-            go [] !op = do-               let !br' = BufferRange op ope0-               k br'--            go xs@(x':xs') !op-              | op `plusPtr` bound <= ope0 = do-                  !op' <- runB w x' op-                  go xs' op'-             | otherwise = return $ bufferFull bound op (step xs k)---- TODO: Add 'foldMap/encodeWith' its variants--- TODO: Ensure rewriting 'encodeWithB w . f = encodeWithB (w #. f)'---- | Create a 'Builder' that encodes a sequence generated from a seed value--- using an 'Encoding'.-{-# INLINE encodeUnfoldrWithB #-}-encodeUnfoldrWithB :: BoundedEncoding b -> (a -> Maybe (b, a)) -> a -> Builder-encodeUnfoldrWithB w =-    makeBuilder-  where-    bound = I.sizeBound w-    makeBuilder f x0 = builder $ step x0-      where-        step x1 !k = fill x1-          where-            fill x !(BufferRange pf0 pe0) = go (f x) pf0-              where-                go !Nothing        !pf = do-                    let !br' = BufferRange pf pe0-                    k br'-                go !(Just (y, x')) !pf-                  | pf `plusPtr` bound <= pe0 = do-                      !pf' <- runB w y pf-                      go (f x') pf'-                  | otherwise = return $ bufferFull bound pf $-                      \(BufferRange pfNew peNew) -> do-                          !pfNew' <- runB w y pfNew-                          fill x' (BufferRange pfNew' peNew)---- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString'--- using an 'Encoding'. For example, we can write a 'Builder' that filters--- a strict 'S.ByteString' as follows.------ > import Codec.Bounded.Encoding as E (encodeIf, word8, encodeNothing)------ > filterBS p = E.encodeIf p E.word8 E.encodeNothing----{-# INLINE encodeByteStringWithB #-}-encodeByteStringWithB :: BoundedEncoding Word8 -> S.ByteString -> Builder-encodeByteStringWithB w =-    \bs -> builder $ step bs-  where-    bound = I.sizeBound w-    step (S.PS ifp ioff isize) !k =-        goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff)-      where-        !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)-        goBS !ip0 !br@(BufferRange op0 ope)-          | ip0 >= ipe = do-              touchForeignPtr ifp -- input buffer consumed-              k br--          | op0 `plusPtr` bound < ope =-              goPartial (ip0 `plusPtr` min outRemaining inpRemaining)--          | otherwise  = return $ bufferFull bound op0 (goBS ip0)-          where-            outRemaining = (ope `minusPtr` op0) `div` bound-            inpRemaining = ipe `minusPtr` ip0--            goPartial !ipeTmp = go ip0 op0-              where-                go !ip !op-                  | ip < ipeTmp = do-                      x   <- peek ip-                      op' <- runB w x op-                      go (ip `plusPtr` 1) op'-                  | otherwise =-                      goBS ip (BufferRange op ope)---- | Chunk-wise application of 'encodeByteStringWith'.-{-# INLINE encodeLazyByteStringWithB #-}-encodeLazyByteStringWithB :: BoundedEncoding Word8 -> L.ByteString -> Builder-encodeLazyByteStringWithB w =-    L.foldrChunks (\x b -> encodeByteStringWithB w x `mappend` b) mempty------------------------------------------------------------------------------------ Char8 encoding----------------------------------------------------------------------------------- | Char8 encode a 'Char'.-{-# INLINE char8 #-}-char8 :: FixedEncoding Char-char8 = (fromIntegral . ord) >$< word8------------------------------------------------------------------------------------ UTF-8 encoding----------------------------------------------------------------------------------- | UTF-8 encode a 'Char'.-{-# INLINE charUtf8 #-}-charUtf8 :: BoundedEncoding Char-charUtf8 = boundedEncoding 4 (encodeCharUtf8 f1 f2 f3 f4)-  where-    pokeN n io op  = io op >> return (op `plusPtr` n)--    f1 x1          = pokeN 1 $ \op -> do pokeByteOff op 0 x1--    f2 x1 x2       = pokeN 2 $ \op -> do pokeByteOff op 0 x1-                                         pokeByteOff op 1 x2--    f3 x1 x2 x3    = pokeN 3 $ \op -> do pokeByteOff op 0 x1-                                         pokeByteOff op 1 x2-                                         pokeByteOff op 2 x3--    f4 x1 x2 x3 x4 = pokeN 4 $ \op -> do pokeByteOff op 0 x1-                                         pokeByteOff op 1 x2-                                         pokeByteOff op 2 x3-                                         pokeByteOff op 3 x4---- | Encode a Unicode character to another datatype, using UTF-8. This function--- acts as an abstract way of encoding characters, as it is unaware of what--- needs to happen with the resulting bytes: you have to specify functions to--- deal with those.----{-# INLINE encodeCharUtf8 #-}-encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8-               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8-               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8-               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8-               -> Char                                     -- ^ Input 'Char'-               -> a                                        -- ^ Result-encodeCharUtf8 f1 f2 f3 f4 c = case ord c of-    x | x <= 0x7F -> f1 $ fromIntegral x-      | x <= 0x07FF ->-           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0-               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80-           in f2 x1 x2-      | x <= 0xFFFF ->-           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0-               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80-               x3 = fromIntegral $ (x .&. 0x3F) + 0x80-           in f3 x1 x2 x3-      | otherwise ->-           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0-               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80-               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80-               x4 = fromIntegral $ (x .&. 0x3F) + 0x80-           in f4 x1 x2 x3 x4------------------------------------------------------------------------------------ Testing encodings----------------------------------------------------------------------------------- | /For testing use only./ Evaluate a 'FixedEncoding' on a given value.-evalF :: FixedEncoding a -> a -> [Word8]-evalF fe = S.unpack . S.unsafeCreate (I.size fe) . runF fe---- | /For testing use only./ Evaluate a 'BoundedEncoding' on a given value.-evalB :: BoundedEncoding a -> a -> [Word8]-evalB be x = S.unpack $ unsafePerformIO $-    S.createAndTrim (I.sizeBound be) $ \op -> do-        op' <- runB be x op-        return (op' `minusPtr` op)---- | /For testing use only./ Show the result of a 'FixedEncoding' of a given--- value as a 'String' by interpreting the resulting bytes as Unicode--- codepoints.-showF :: FixedEncoding a -> a -> String-showF fe = map (chr . fromIntegral) . evalF fe---- | /For testing use only./ Show the result of a 'BoundedEncoding' of a given--- value as a 'String' by interpreting the resulting bytes as Unicode--- codepoints.-showB :: BoundedEncoding a -> a -> String-showB be = map (chr . fromIntegral) . evalB be--

@@ -1,287 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}--- | Copyright   : (c) 2010 Jasper Van der Jeugt---                 (c) 2010 - 2011 Simon Meier--- License       : BSD3-style (see LICENSE)------ Maintainer    : Simon Meier <iridcode@gmail.com>--- Portability   : GHC------ Encodings using ASCII encoded Unicode characters.----module Data.ByteString.Lazy.Builder.BasicEncoding.ASCII-    (--     -- *** ASCII-     char7--      -- **** Decimal numbers-      -- | Decimal encoding of numbers using ASCII encoded characters.-    , int8Dec-    , int16Dec-    , int32Dec-    , int64Dec-    , intDec--    , word8Dec-    , word16Dec-    , word32Dec-    , word64Dec-    , wordDec--    {--    -- These are the functions currently provided by Bryan O'Sullivans-    -- double-conversion library.-    ---    -- , float-    -- , floatWith-    -- , double-    -- , doubleWith-    -}--      -- **** Hexadecimal numbers--      -- | Encoding positive integers as hexadecimal numbers using lower-case-      -- ASCII characters. The shortest possible representation is used. For-      -- example,-      ---      -- > showB word16Hex 0x0a10 = "a10"-      ---      -- Note that there is no support for using upper-case characters. Please-      -- contact the maintainer if your application cannot work without-      -- hexadecimal encodings that use upper-case characters.-      ---    , word8Hex-    , word16Hex-    , word32Hex-    , word64Hex-    , wordHex--      -- **** Fixed-width hexadecimal numbers-      ---      -- | Encoding the bytes of fixed-width types as hexadecimal-      -- numbers using lower-case ASCII characters. For example,-      ---      -- > showF word16HexFixed 0x0a10 = "0a10"-      ---    , int8HexFixed-    , int16HexFixed-    , int32HexFixed-    , int64HexFixed-    , word8HexFixed-    , word16HexFixed-    , word32HexFixed-    , word64HexFixed-    , floatHexFixed-    , doubleHexFixed--    ) where--import Data.ByteString.Lazy.Builder.BasicEncoding.Binary-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts--import Data.Char (ord)--import Foreign-import Foreign.C.Types---- | Encode the least 7-bits of a 'Char' using the ASCII encoding.-{-# INLINE char7 #-}-char7 :: FixedEncoding Char-char7 = (\c -> fromIntegral $ ord c .&. 0x7f) >$< word8------------------------------------------------------------------------------------ Decimal Encoding----------------------------------------------------------------------------------- Signed integers---------------------foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec-    :: CInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec-    :: CLLong -> Ptr Word8 -> IO (Ptr Word8)--{-# INLINE encodeIntDecimal #-}-encodeIntDecimal :: Integral a => Int -> BoundedEncoding a-encodeIntDecimal bound = boundedEncoding bound $ c_int_dec . fromIntegral---- | Decimal encoding of an 'Int8'.-{-# INLINE int8Dec #-}-int8Dec :: BoundedEncoding Int8-int8Dec = encodeIntDecimal 4---- | Decimal encoding of an 'Int16'.-{-# INLINE int16Dec #-}-int16Dec :: BoundedEncoding Int16-int16Dec = encodeIntDecimal 6----- | Decimal encoding of an 'Int32'.-{-# INLINE int32Dec #-}-int32Dec :: BoundedEncoding Int32-int32Dec = encodeIntDecimal 11---- | Decimal encoding of an 'Int64'.-{-# INLINE int64Dec #-}-int64Dec :: BoundedEncoding Int64-int64Dec = boundedEncoding 20 $ c_long_long_int_dec . fromIntegral---- | Decimal encoding of an 'Int'.-{-# INLINE intDec #-}-intDec :: BoundedEncoding Int-intDec = caseWordSize_32_64-    (fromIntegral >$< int32Dec)-    (fromIntegral >$< int64Dec)----- Unsigned integers-----------------------foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec-    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec-    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)--{-# INLINE encodeWordDecimal #-}-encodeWordDecimal :: Integral a => Int -> BoundedEncoding a-encodeWordDecimal bound = boundedEncoding bound $ c_uint_dec . fromIntegral---- | Decimal encoding of a 'Word8'.-{-# INLINE word8Dec #-}-word8Dec :: BoundedEncoding Word8-word8Dec = encodeWordDecimal 3---- | Decimal encoding of a 'Word16'.-{-# INLINE word16Dec #-}-word16Dec :: BoundedEncoding Word16-word16Dec = encodeWordDecimal 5---- | Decimal encoding of a 'Word32'.-{-# INLINE word32Dec #-}-word32Dec :: BoundedEncoding Word32-word32Dec = encodeWordDecimal 10---- | Decimal encoding of a 'Word64'.-{-# INLINE word64Dec #-}-word64Dec :: BoundedEncoding Word64-word64Dec = boundedEncoding 20 $ c_long_long_uint_dec . fromIntegral---- | Decimal encoding of a 'Word'.-{-# INLINE wordDec #-}-wordDec :: BoundedEncoding Word-wordDec = caseWordSize_32_64-    (fromIntegral >$< word32Dec)-    (fromIntegral >$< word64Dec)----------------------------------------------------------------------------------- Hexadecimal Encoding----------------------------------------------------------------------------------- without lead------------------foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex-    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex-    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)--{-# INLINE encodeWordHex #-}-encodeWordHex :: forall a. (Storable a, Integral a) => BoundedEncoding a-encodeWordHex =-    boundedEncoding (2 * sizeOf (undefined :: a)) $ c_uint_hex  . fromIntegral---- | Hexadecimal encoding of a 'Word8'.-{-# INLINE word8Hex #-}-word8Hex :: BoundedEncoding Word8-word8Hex = encodeWordHex---- | Hexadecimal encoding of a 'Word16'.-{-# INLINE word16Hex #-}-word16Hex :: BoundedEncoding Word16-word16Hex = encodeWordHex---- | Hexadecimal encoding of a 'Word32'.-{-# INLINE word32Hex #-}-word32Hex :: BoundedEncoding Word32-word32Hex = encodeWordHex---- | Hexadecimal encoding of a 'Word64'.-{-# INLINE word64Hex #-}-word64Hex :: BoundedEncoding Word64-word64Hex = boundedEncoding 16 $ c_long_long_uint_hex . fromIntegral---- | Hexadecimal encoding of a 'Word'.-{-# INLINE wordHex #-}-wordHex :: BoundedEncoding Word-wordHex = caseWordSize_32_64-    (fromIntegral >$< word32Hex)-    (fromIntegral >$< word64Hex)----- fixed width; leading zeroes----------------------------------- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).-{-# INLINE word8HexFixed #-}-word8HexFixed :: FixedEncoding Word8-word8HexFixed = fixedEncoding 2 $-    \x op -> poke (castPtr op) =<< encode8_as_16h lowerTable x---- | Encode a 'Word16' using 4 nibbles.-{-# INLINE word16HexFixed #-}-word16HexFixed :: FixedEncoding Word16-word16HexFixed =-    (\x -> (fromIntegral $ x `shiftr_w16` 8, fromIntegral x))-      >$< pairF word8HexFixed word8HexFixed---- | Encode a 'Word32' using 8 nibbles.-{-# INLINE word32HexFixed #-}-word32HexFixed :: FixedEncoding Word32-word32HexFixed =-    (\x -> (fromIntegral $ x `shiftr_w32` 16, fromIntegral x))-      >$< pairF word16HexFixed word16HexFixed--- | Encode a 'Word64' using 16 nibbles.-{-# INLINE word64HexFixed #-}-word64HexFixed :: FixedEncoding Word64-word64HexFixed =-    (\x -> (fromIntegral $ x `shiftr_w64` 32, fromIntegral x))-      >$< pairF word32HexFixed word32HexFixed---- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).-{-# INLINE int8HexFixed #-}-int8HexFixed :: FixedEncoding Int8-int8HexFixed = fromIntegral >$< word8HexFixed---- | Encode a 'Int16' using 4 nibbles.-{-# INLINE int16HexFixed #-}-int16HexFixed :: FixedEncoding Int16-int16HexFixed = fromIntegral >$< word16HexFixed---- | Encode a 'Int32' using 8 nibbles.-{-# INLINE int32HexFixed #-}-int32HexFixed :: FixedEncoding Int32-int32HexFixed = fromIntegral >$< word32HexFixed---- | Encode a 'Int64' using 16 nibbles.-{-# INLINE int64HexFixed #-}-int64HexFixed :: FixedEncoding Int64-int64HexFixed = fromIntegral >$< word64HexFixed---- | Encode an IEEE 'Float' using 8 nibbles.-{-# INLINE floatHexFixed #-}-floatHexFixed :: FixedEncoding Float-floatHexFixed = encodeFloatViaWord32F word32HexFixed---- | Encode an IEEE 'Double' using 16 nibbles.-{-# INLINE doubleHexFixed #-}-doubleHexFixed :: FixedEncoding Double-doubleHexFixed = encodeDoubleViaWord64F word64HexFixed--

@@ -1,336 +0,0 @@-{-# LANGUAGE CPP, BangPatterns #-}--- | Copyright   : (c) 2010-2011 Simon Meier--- License       : BSD3-style (see LICENSE)------ Maintainer    : Simon Meier <iridcode@gmail.com>--- Portability   : GHC----module Data.ByteString.Lazy.Builder.BasicEncoding.Binary (--  -- ** Binary encodings-    int8-  , word8--  -- *** Big-endian-  , int16BE-  , int32BE-  , int64BE--  , word16BE-  , word32BE-  , word64BE--  , floatBE-  , doubleBE--  -- *** Little-endian-  , int16LE-  , int32LE-  , int64LE--  , word16LE-  , word32LE-  , word64LE--  , floatLE-  , doubleLE--  -- *** Non-portable, host-dependent-  , intHost-  , int16Host-  , int32Host-  , int64Host--  , wordHost-  , word16Host-  , word32Host-  , word64Host--  , floatHost-  , doubleHost--  ) where--import Data.ByteString.Lazy.Builder.BasicEncoding.Internal-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts-import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating--import Foreign--#include "MachDeps.h"----------------------------------------------------------------------------------- Binary encoding----------------------------------------------------------------------------------- Word encodings---------------------- | Encoding single unsigned bytes as-is.----{-# INLINE word8 #-}-word8 :: FixedEncoding Word8-word8 = storableToF------- We rely on the fromIntegral to do the right masking for us.--- The inlining here is critical, and can be worth 4x performance------- | Encoding 'Word16's in big endian format.-{-# INLINE word16BE #-}-word16BE :: FixedEncoding Word16-#ifdef WORD_BIGENDIAN-word16BE = word16Host-#else-word16BE = fixedEncoding 2 $ \w p -> do-    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)-#endif---- | Encoding 'Word16's in little endian format.-{-# INLINE word16LE #-}-word16LE :: FixedEncoding Word16-#ifdef WORD_BIGENDIAN-word16LE = fixedEncoding 2 $ \w p -> do-    poke p               (fromIntegral (w)              :: Word8)-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)-#else-word16LE = word16Host-#endif---- | Encoding 'Word32's in big endian format.-{-# INLINE word32BE #-}-word32BE :: FixedEncoding Word32-#ifdef WORD_BIGENDIAN-word32BE = word32Host-#else-word32BE = fixedEncoding 4 $ \w 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)-#endif---- | Encoding 'Word32's in little endian format.-{-# INLINE word32LE #-}-word32LE :: FixedEncoding Word32-#ifdef WORD_BIGENDIAN-word32LE = fixedEncoding 4 $ \w 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)-#else-word32LE = word32Host-#endif---- on a little endian machine:--- word32LE w32 = fixedEncoding 4 (\w p -> poke (castPtr p) w32)---- | Encoding 'Word64's in big endian format.-{-# INLINE word64BE #-}-word64BE :: FixedEncoding Word64-#ifdef WORD_BIGENDIAN-word64BE = word64Host-#else-#if WORD_SIZE_IN_BITS < 64------ To avoid expensive 64 bit shifts on 32 bit machines, we cast to--- Word32, and write that----word64BE =-    fixedEncoding 8 $ \w p -> do-        let a = fromIntegral (shiftr_w64 w 32) :: Word32-            b = fromIntegral w                 :: Word32-        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-word64BE = fixedEncoding 8 $ \w 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-#endif---- | Encoding 'Word64's in little endian format.-{-# INLINE word64LE #-}-word64LE :: FixedEncoding Word64-#ifdef WORD_BIGENDIAN-#if WORD_SIZE_IN_BITS < 64-word64LE =-    fixedEncoding 8 $ \w p -> do-        let b = fromIntegral (shiftr_w64 w 32) :: Word32-            a = fromIntegral w                 :: Word32-        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-word64LE = fixedEncoding 8 $ \w 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-#else-word64LE = word64Host-#endif----- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,--- host endian form, for the machine you are on. On a 64 bit machine the 'Word'--- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way--- are not portable to different endian or word sized machines, without--- conversion.----{-# INLINE wordHost #-}-wordHost :: FixedEncoding Word-wordHost = storableToF---- | Encoding 'Word16's in native host order and host endianness.-{-# INLINE word16Host #-}-word16Host :: FixedEncoding Word16-word16Host = storableToF---- | Encoding 'Word32's in native host order and host endianness.-{-# INLINE word32Host #-}-word32Host :: FixedEncoding Word32-word32Host = storableToF---- | Encoding 'Word64's in native host order and host endianness.-{-# INLINE word64Host #-}-word64Host :: FixedEncoding Word64-word64Host = storableToF------------------------------------------------------------------------------------ Int encodings------------------------------------------------------------------------------------- We rely on 'fromIntegral' to do a loss-less conversion to the corresponding--- 'Word' type-------------------------------------------------------------------------------------- | Encoding single signed bytes as-is.----{-# INLINE int8 #-}-int8 :: FixedEncoding Int8-int8 = fromIntegral >$< word8---- | Encoding 'Int16's in big endian format.-{-# INLINE int16BE #-}-int16BE :: FixedEncoding Int16-int16BE = fromIntegral >$< word16BE---- | Encoding 'Int16's in little endian format.-{-# INLINE int16LE #-}-int16LE :: FixedEncoding Int16-int16LE = fromIntegral >$< word16LE---- | Encoding 'Int32's in big endian format.-{-# INLINE int32BE #-}-int32BE :: FixedEncoding Int32-int32BE = fromIntegral >$< word32BE---- | Encoding 'Int32's in little endian format.-{-# INLINE int32LE #-}-int32LE :: FixedEncoding Int32-int32LE = fromIntegral >$< word32LE---- | Encoding 'Int64's in big endian format.-{-# INLINE int64BE #-}-int64BE :: FixedEncoding Int64-int64BE = fromIntegral >$< word64BE---- | Encoding 'Int64's in little endian format.-{-# INLINE int64LE #-}-int64LE :: FixedEncoding Int64-int64LE = fromIntegral >$< word64LE----- TODO: Ensure that they are safe on architectures where an unaligned write is--- an error.---- | Encode a single native machine 'Int'. The 'Int's is encoded in host order,--- host endian form, for the machine you are on. On a 64 bit machine the 'Int'--- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way--- are not portable to different endian or integer sized machines, without--- conversion.----{-# INLINE intHost #-}-intHost :: FixedEncoding Int-intHost = storableToF---- | Encoding 'Int16's in native host order and host endianness.-{-# INLINE int16Host #-}-int16Host :: FixedEncoding Int16-int16Host = storableToF---- | Encoding 'Int32's in native host order and host endianness.-{-# INLINE int32Host #-}-int32Host :: FixedEncoding Int32-int32Host = storableToF---- | Encoding 'Int64's in native host order and host endianness.-{-# INLINE int64Host #-}-int64Host :: FixedEncoding Int64-int64Host = storableToF---- IEEE Floating Point Numbers----------------------------------- | Encode a 'Float' in big endian format.-{-# INLINE floatBE #-}-floatBE :: FixedEncoding Float-floatBE = encodeFloatViaWord32F word32BE---- | Encode a 'Float' in little endian format.-{-# INLINE floatLE #-}-floatLE :: FixedEncoding Float-floatLE = encodeFloatViaWord32F word32LE---- | Encode a 'Double' in big endian format.-{-# INLINE doubleBE #-}-doubleBE :: FixedEncoding Double-doubleBE = encodeDoubleViaWord64F word64BE---- | Encode a 'Double' in little endian format.-{-# INLINE doubleLE #-}-doubleLE :: FixedEncoding Double-doubleLE = encodeDoubleViaWord64F word64LE----- | Encode a 'Float' in native host order and host endianness. Values written--- this way are not portable to different endian machines, without conversion.----{-# INLINE floatHost #-}-floatHost :: FixedEncoding Float-floatHost = storableToF---- | Encode a 'Double' in native host order and host endianness.-{-# INLINE doubleHost #-}-doubleHost :: FixedEncoding Double-doubleHost = storableToF--

@@ -1,890 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_HADDOCK hide #-}-{- | Copyright : (c) 2010-2011 Simon Meier-License        : BSD3-style (see LICENSE)--Maintainer     : Simon Meier <iridcode@gmail.com>-Stability      : experimental-Portability    : GHC--An /encoding/ is a conversion function of Haskell values to sequences of bytes.-A /fixed(-size) encoding/ is an encoding that always results in sequence of bytes-  of a pre-determined, fixed length.-An example for a fixed encoding is the big-endian encoding of a 'Word64',-  which always results in exactly 8 bytes.-A /bounded(-size) encoding/ is an encoding that always results in sequence-  of bytes that is no larger than a pre-determined bound.-An example for a bounded encoding is the UTF-8 encoding of a 'Char',-  which results always in less or equal to 4 bytes.-Note that every fixed encoding is also a bounded encoding.-We explicitly identify fixed encodings because they allow some optimizations-  that are impossible with bounded encodings.-In the following,-  we first motivate the use of bounded encodings-  and then give examples of optimizations-  that are only possible with fixed encodings.--Typicall, encodings are implemented efficiently by allocating a buffer-  (a mutable array of bytes)-  and repeatedly executing the following two steps:-  (1) writing to the buffer until it is full and-  (2) handing over the filled part to the consumer of the encoded value.-Step (1) is where bounded encodings are used.-We must use a bounded encoding,-  as we must check that there is enough free space-  /before/ actually writing to the buffer.--In term of expressivity,-  it would be sufficient to construct all encodings-  from the single fixed encoding that encodes a 'Word8' as-is.-However,-  this is not sufficient in terms of efficiency.-It results in unnecessary buffer-full checks and-  it complicates the program-flow for writing to the buffer,-  as buffer-full checks are interleaved with analyzing the value to be-  encoded (e.g., think about the program-flow for UTF-8 encoding).-This has a significant effect on overall encoding performance,-  as encoding primitive Haskell values such as 'Word8's or 'Char's-  lies at the heart of every encoding implementation.--The 'BoundedEncoding's provided by this module remove this performance problem.-Intuitively,-  they consist of a tuple of the bound on the maximal number of bytes written-  and the actual implementation of the encoding as-  a function that modifies a mutable buffer.-Hence when executing a 'BoundedEncoding',- the buffer-full check can be done once before the actual writing to the buffer.-The provided 'BoundedEncoding's also take care to implement the-  actual writing to the buffer efficiently.-Moreover, combinators are provided to construct new bounded encodings-  from the provided ones.----The result of an encoding can be consumed efficiently,-  if it is represented as a sequence of large enough-  /chunks/ of consecutive memory (i.e., C @char@ arrays).-The precise meaning of /large enough/ is application dependent.-Typically, an average chunk size between 4kb and 32kb is suitable-  for writing the result to disk or sending it over the network.-We desire large enough chunk sizes because each chunk boundary-  incurs extra work that we must be able to amortize.---The need for fixed-size encodings arises when considering-  the efficient implementation of encodings that require the encoding of a-  value to be prefixed with the size of the resulting sequence of bytes.-An efficient implementation avoids unnecessary buffer-We can implement this efficiently as follows.-We first reserve the space for the encoding of the size.-Then, we encode the value.-Finally, we encode the size of the resulting sequence of bytes into-  the reserved space.-For this to work--This works only if the encoding resulting size fits--by first, reserving the space for the encoding-  of the size, then performing the--For efficiency,-  we want to avoid unnecessary copying.---For example, the HTTP/1.0 requires the size of the body to be given in-  the Content-Length field.--chunked-transfer encoding requires each chunk to-  be prefixed with the hexadecimal encoding of the chunk size.----}--{---------- A /bounded encoding/ is an encoding that never results in a sequence--- longer than some fixed number of bytes. This number of bytes must be--- independent of the value being encoded. Typical examples of bounded--- encodings are the big-endian encoding of a 'Word64', which results always--- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always--- in less or equal to 4 bytes.------ Typically, encodings are implemented efficiently by allocating a buffer (an--- array of bytes) and repeatedly executing the following two steps: (1)--- writing to the buffer until it is full and (2) handing over the filled part--- to the consumer of the encoded value. Step (1) is where bounded encodings--- are used. We must use a bounded encoding, as we must check that there is--- enough free space /before/ actually writing to the buffer.------ In term of expressivity, it would be sufficient to construct all encodings--- from the single bounded encoding that encodes a 'Word8' as-is. However,--- this is not sufficient in terms of efficiency. It results in unnecessary--- buffer-full checks and it complicates the program-flow for writing to the--- buffer, as buffer-full checks are interleaved with analyzing the value to be--- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a--- significant effect on overall encoding performance, as encoding primitive--- Haskell values such as 'Word8's or 'Char's lies at the heart of every--- encoding implementation.------ The bounded 'Encoding's provided by this module remove this performance--- problem. Intuitively, they consist of a tuple of the bound on the maximal--- number of bytes written and the actual implementation of the encoding as a--- function that modifies a mutable buffer. Hence when executing a bounded--- 'Encoding', the buffer-full check can be done once before the actual writing--- to the buffer. The provided 'Encoding's also take care to implement the--- actual writing to the buffer efficiently. Moreover, combinators are--- provided to construct new bounded encodings from the provided ones.------ A typical example for using the combinators is a bounded 'Encoding' that--- combines escaping the ' and \\ characters with UTF-8 encoding. More--- precisely, the escaping to be done is the one implemented by the following--- @escape@ function.------ > escape :: Char -> [Char]--- > escape '\'' = "\\'"--- > escape '\\' = "\\\\"--- > escape c    = [c]------ The bounded 'Encoding' that combines this escaping with UTF-8 encoding is--- the following.------ > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)--- >--- > {-# INLINE escapeChar #-}--- > escapeUtf8 :: BoundedEncoding Char--- > escapeUtf8 =--- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $--- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $--- >     char------ The definition of 'escapeUtf8' is more complicated than 'escape', because--- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in--- 'escapeChar' compute both the bound on the maximal number of bytes written--- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required--- to implement the encoding. Bounded 'Encoding's should always be inlined.--- Otherwise, the compiler cannot compute the bound on the maximal number of--- bytes written at compile-time. Without inlinining, it would also fail to--- optimize the constant encoding of the escape characters in the above--- example. Functions that execute bounded 'Encoding's also perform--- suboptimally, if the definition of the bounded 'Encoding' is not inlined.--- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.------ Currently, the only library that executes bounded 'Encoding's is the--- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It--- uses bounded 'Encoding's to implement most of its lazy bytestring builders.--- Executing a bounded encoding should be done using the corresponding--- functions in the lazy bytestring builder 'Extras' module.------ TODO: Merge with explanation/example below------ Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by--- writing a bounded-size sequence of bytes directly to memory. They are--- lifted to conversions from Haskell values to 'Builder's by wrapping them--- with a bound-check. The compiler can implement this bound-check very--- efficiently (i.e, a single comparison of the difference of two pointers to a--- constant), because the bound of a 'E.Encoding' is always independent of the--- value being encoded and, in most cases, a literal constant.------ 'E.Encoding's are the primary means for defining conversion functions from--- primitive Haskell values to 'Builder's. Most 'Builder' constructors--- provided by this library are implemented that way.--- 'E.Encoding's are also used to construct conversions that exploit the internal--- representation of data-structures.------ For example, 'encodeByteStringWith' works directly on the underlying byte--- array and uses some tricks to reduce the number of variables in its inner--- loop. Its efficiency is exploited for implementing the @filter@ and @map@--- functions in "Data.ByteString.Lazy" as------ > import qualified Codec.Bounded.Encoding as E--- >--- > filter :: (Word8 -> Bool) -> ByteString -> ByteString--- > filter p = toLazyByteString . encodeLazyByteStringWithB write--- >   where--- >     write = E.encodeIf p E.word8 E.emptyEncoding--- >--- > map :: (Word8 -> Word8) -> ByteString -> ByteString--- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)------ Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,--- these versions use a more efficient inner loop and have the additional--- advantage that they always result in well-chunked 'L.ByteString's; i.e, they--- also perform automatic defragmentation.------ We can also use 'E.Encoding's to improve the efficiency of the following--- 'renderString' function from our UTF-8 CSV table encoding example in--- "Data.ByteString.Lazy.Builder".------ > renderString :: String -> Builder--- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'--- >   where--- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'--- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'--- >     escape c    = charUtf8 c------ The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes--- characters and using 'encodeListWith', which implements writing a list of--- values with a tighter inner loop and no 'mappend'.------ > import Data.ByteString.Lazy.Builder.Extras     -- assume these three--- > import Codec.Bounded.Encoding                  -- imports are present--- >        ( BoundedEncoding, encodeIf, (<#>), (#.) )--- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)--- >--- > renderString :: String -> Builder--- > renderString cs =--- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'--- >   where--- >     escapedUtf8 :: BoundedEncoding Char--- >     escapedUtf8 =--- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $--- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $--- >       char------ This 'Builder' considers a buffer with less than 8 free bytes as full. As--- all functions are inlined, the compiler is able to optimize the constant--- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of--- 'renderString' this implementation is 1.7x faster.-----}-{--Internally, 'Builder's are buffer-fill operations that are-given a continuation buffer-fill operation and a buffer-range to be filled.-A 'Builder' first checks if the buffer-range is large enough. If that's-the case, the 'Builder' writes the sequences of bytes to the buffer and-calls its continuation.  Otherwise, it returns a signal that it requires a-new buffer together with a continuation to be called on this new buffer.-Ignoring the rare case of a full buffer-range, the execution cost of a-'Builder' consists of three parts:--  1. The time taken to read the parameters; i.e., the buffer-fill-     operation to call after the 'Builder' is done and the buffer-range to-     fill.--  2. The time taken to check for the size of the buffer-range.--  3. The time taken for the actual encoding.--We can reduce cost (1) by ensuring that fewer buffer-fill function calls are-required. We can reduce cost (2) by fusing buffer-size checks of sequential-writes. For example, when escaping a 'String' using 'renderString', it would-be sufficient to check before encoding a character that at least 8 bytes are-free. We can reduce cost (3) by implementing better primitive 'Builder's.-For example, 'renderCell' builds an intermediate list containing the decimal-representation of an 'Int'. Implementing a direct decimal encoding of 'Int's-to memory would be more efficient, as it requires fewer buffer-size checks-and less allocation. It is also a planned extension of this library.--The first two cost reductions are supported for user code through functions-in "Data.ByteString.Lazy.Builder.Extras". There, we continue the above example-and drop the generation time to 0.8ms by implementing 'renderString' more-cleverly. The third reduction requires meddling with the internals of-'Builder's and is not recomended in code outside of this library. However,-patches to this library are very welcome.--}-module Data.ByteString.Lazy.Builder.BasicEncoding.Extras (--  -- * Base-128, variable-length binary encodings-  {- |-There are many options for implementing a base-128 (i.e, 7-bit),-variable-length encoding. The encoding implemented here is the one used by-Google's protocol buffer library-<http://code.google.com/apis/protocolbuffers/docs/encoding.html#varints>.  This-encoding can be implemented efficiently and provides the desired property that-small positive integers result in short sequences of bytes. It is intended to-be used for the new default binary serialization format of the differently-sized 'Word' types. It works as follows.--The most-significant bit (MSB) of each output byte indicates whether-there is a following byte (MSB set to 1) or it is the last byte (MSB set to 0).-The remaining 7-bits are used to encode the input starting with the least-significant 7-bit group of the input (i.e., a little-endian ordering of the-7-bit groups is used).--For example, the value @1 :: Int@ is encoded as @[0x01]@. The value-@128 :: Int@, whose binary representation is @1000 0000@, is encoded as-@[0x80, 0x01]@; i.e., the first byte has its MSB set and the least significant-7-bit group is @000 0000@, the second byte has its MSB not set (it is the last-byte) and its 7-bit group is @000 0001@.--}-    word8Var-  , word16Var-  , word32Var-  , word64Var-  , wordVar--{- |-The following encodings work by casting the signed integer to the equally sized-unsigned integer. This works well for positive integers, but for negative-integers it always results in the longest possible sequence of bytes,-as their MSB is (by definition) always set.--}--  , int8Var-  , int16Var-  , int32Var-  , int64Var-  , intVar--{- |-Positive and negative integers of small magnitude can be encoded compactly-  using the so-called ZigZag encoding-  (<http://code.google.com/apis/protocolbuffers/docs/encoding.html#types>).-The /ZigZag encoding/ uses-  even numbers to encode the postive integers and-  odd numbers to encode the negative integers.-For example,-  @0@ is encoded as @0@, @-1@ as @1@, @1@ as @2@, @-2@ as @3@, @2@ as @4@, and-  so on.-Its efficient implementation uses some bit-level magic.-For example--@-zigZag32 :: 'Int32' -> 'Word32'-zigZag32 n = fromIntegral ((n \`shiftL\` 1) \`xor\` (n \`shiftR\` 31))-@--Note that the 'shiftR' is an arithmetic shift that performs sign extension.-The ZigZag encoding essentially swaps the LSB with the MSB and additionally-inverts all bits if the MSB is set.--The following encodings implement the combintion of ZigZag encoding-  together with the above base-128, variable length encodings.-They are intended to become the the new default binary serialization format of-  the differently sized 'Int' types.--}-  , int8VarSigned-  , int16VarSigned-  , int32VarSigned-  , int64VarSigned-  , intVarSigned---  -- * Chunked / size-prefixed encodings-{- |-Some encodings like ASN.1 BER <http://en.wikipedia.org/wiki/Basic_Encoding_Rules>-or Google's protocol buffers <http://code.google.com/p/protobuf/> require-encoded data to be prefixed with its length. The simple method to achieve this-is to encode the data first into a separate buffer, compute the length of the-encoded data, write it to the current output buffer, and append the separate-buffers. The drawback of this method is that it requires a ...--}-  , size-  , sizeBound-  -- , withSizeFB-  -- , withSizeBB-  , encodeWithSize--  , encodeChunked--  , wordVarFixedBound-  , wordHexFixedBound-  , wordDecFixedBound--  , word64VarFixedBound-  , word64HexFixedBound-  , word64DecFixedBound--  ) where--import           Data.ByteString.Lazy.Builder.Internal-import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts-import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16 (lowerTable, encode4_as_8)--import qualified Data.ByteString               as S-import qualified Data.ByteString.Internal      as S-import qualified Data.ByteString.Lazy.Internal as L--import           Data.Monoid-import           Data.List (unfoldr)  -- HADDOCK ONLY-import           Data.Char (chr, ord)-import           Control.Monad ((<=<), unless)--import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal hiding (size, sizeBound)-import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as I (size, sizeBound)-import           Data.ByteString.Lazy.Builder.BasicEncoding.Binary-import           Data.ByteString.Lazy.Builder.BasicEncoding.ASCII-import           Data.ByteString.Lazy.Builder.BasicEncoding--import           Foreign----------------------------------------------------------------------------------- Adapting 'size' for the public interface.----------------------------------------------------------------------------------- | The size of the sequence of bytes generated by this 'FixedEncoding'.-size :: FixedEncoding a -> Word-size = fromIntegral . I.size---- | The bound on the size of the sequence of bytes generated by this--- 'BoundedEncoding'.-sizeBound :: BoundedEncoding a -> Word-sizeBound = fromIntegral . I.sizeBound------------------------------------------------------------------------------------ Base-128 Variable-Length Encodings---------------------------------------------------------------------------------{-# INLINE encodeBase128 #-}-encodeBase128-    :: forall a b. (Integral a, Bits a, Storable b, Integral b, Num b)-    => (a -> Int -> a) -> BoundedEncoding b-encodeBase128 shiftr =-    -- We add 6 because we require the result of (`div` 7) to be rounded up.-    boundedEncoding ((8 * sizeOf (undefined :: b) + 6) `div` 7) (io . fromIntegral)-  where-    io !x !op-      | x' == 0   = do poke8 (x .&. 0x7f)-                       return $! op `plusPtr` 1-      | otherwise = do poke8 ((x .&. 0x7f) .|. 0x80)-                       io x' (op `plusPtr` 1)-      where-        x'    = x `shiftr` 7-        poke8 = poke op . fromIntegral---- | Base-128, variable length encoding of a 'Word8'.-{-# INLINE word8Var #-}-word8Var :: BoundedEncoding Word8-word8Var = encodeBase128 shiftr_w---- | Base-128, variable length encoding of a 'Word16'.-{-# INLINE word16Var #-}-word16Var :: BoundedEncoding Word16-word16Var = encodeBase128 shiftr_w---- | Base-128, variable length encoding of a 'Word32'.-{-# INLINE word32Var #-}-word32Var :: BoundedEncoding Word32-word32Var = encodeBase128 shiftr_w32---- | Base-128, variable length encoding of a 'Word64'.-{-# INLINE word64Var #-}-word64Var :: BoundedEncoding Word64-word64Var = encodeBase128 shiftr_w64---- | Base-128, variable length encoding of a 'Word'.-{-# INLINE wordVar #-}-wordVar :: BoundedEncoding Word-wordVar = encodeBase128 shiftr_w----- | Base-128, variable length encoding of an 'Int8'.--- Use 'int8VarSigned' for encoding negative numbers.-{-# INLINE int8Var #-}-int8Var :: BoundedEncoding Int8-int8Var = fromIntegral >$< word8Var---- | Base-128, variable length encoding of an 'Int16'.--- Use 'int16VarSigned' for encoding negative numbers.-{-# INLINE int16Var #-}-int16Var :: BoundedEncoding Int16-int16Var = fromIntegral >$< word16Var---- | Base-128, variable length encoding of an 'Int32'.--- Use 'int32VarSigned' for encoding negative numbers.-{-# INLINE int32Var #-}-int32Var :: BoundedEncoding Int32-int32Var = fromIntegral >$< word32Var---- | Base-128, variable length encoding of an 'Int64'.--- Use 'int64VarSigned' for encoding negative numbers.-{-# INLINE int64Var #-}-int64Var :: BoundedEncoding Int64-int64Var = fromIntegral >$< word64Var---- | Base-128, variable length encoding of an 'Int'.--- Use 'intVarSigned' for encoding negative numbers.-{-# INLINE intVar #-}-intVar :: BoundedEncoding Int-intVar = fromIntegral >$< wordVar--{-# INLINE zigZag #-}-zigZag :: (Storable a, Bits a) => a -> a-zigZag x = (x `shiftL` 1) `xor` (x `shiftR` (8 * sizeOf x - 1))---- | Base-128, variable length, ZigZag encoding of an 'Int'.-{-# INLINE int8VarSigned #-}-int8VarSigned :: BoundedEncoding Int8-int8VarSigned = zigZag >$< int8Var---- | Base-128, variable length, ZigZag encoding of an 'Int16'.-{-# INLINE int16VarSigned #-}-int16VarSigned :: BoundedEncoding Int16-int16VarSigned = zigZag >$< int16Var---- | Base-128, variable length, ZigZag encoding of an 'Int32'.-{-# INLINE int32VarSigned #-}-int32VarSigned :: BoundedEncoding Int32-int32VarSigned = zigZag >$< int32Var---- | Base-128, variable length, ZigZag encoding of an 'Int64'.-{-# INLINE int64VarSigned #-}-int64VarSigned :: BoundedEncoding Int64-int64VarSigned = zigZag >$< int64Var---- | Base-128, variable length, ZigZag encoding of an 'Int'.-{-# INLINE intVarSigned #-}-intVarSigned :: BoundedEncoding Int-intVarSigned = zigZag >$< intVar------------------------------------------------------------------------------------- Chunked Encoding Transformer----------------------------------------------------------------------------------- | /Heavy inlining./-{-# INLINE encodeChunked #-}-encodeChunked-    :: Word                           -- ^ Minimal free-size-    -> (Word64 -> FixedEncoding Word64)-    -- ^ Given a sizeBound on the maximal encodable size this function must return-    -- a fixed-size encoding for encoding all smaller size.-    -> (BoundedEncoding Word64)-    -- ^ An encoding for terminating a chunk of the given size.-    -> Builder-    -- ^ Inner Builder to transform-    -> Builder-    -- ^ 'Put' with chunked encoding.-encodeChunked minFree mkBeforeFE afterBE =-    fromPut . putChunked minFree mkBeforeFE afterBE . putBuilder---- | /Heavy inlining./-{-# INLINE putChunked #-}-putChunked-    :: Word                         -- ^ Minimal free-size-    -> (Word64 -> FixedEncoding Word64)-    -- ^ Given a sizeBound on the maximal encodable size this function must return-    -- a fixed-size encoding for encoding all smaller size.-    -> (BoundedEncoding Word64)-    -- ^ Encoding a directly inserted chunk.-    -> Put a-    -- ^ Inner Put to transform-    -> Put a-    -- ^ 'Put' with chunked encoding.-putChunked minFree0 mkBeforeFE afterBE p =-    put encodingStep-  where-    minFree, reservedAfter, maxReserved, minBufferSize :: Int-    minFree       = fromIntegral $ max 1 minFree0   -- sanitize and convert to Int--    -- reserved space must be computed for maximum buffer size to cover for all-    -- sizes of the actually returned buffer.-    reservedAfter = I.sizeBound afterBE-    maxReserved   = I.size (mkBeforeFE maxBound) + reservedAfter-    minBufferSize = minFree + maxReserved--    encodingStep k =-        fill (runPut p)-      where-        fill innerStep !(BufferRange op ope)-          | outRemaining < minBufferSize =-              return $! bufferFull minBufferSize op (fill innerStep)-          | otherwise = do-              fillWithBuildStep innerStep doneH fullH insertChunksH brInner-          where-            outRemaining   = ope `minusPtr` op-            beforeFE       = mkBeforeFE $ fromIntegral outRemaining-            reservedBefore = I.size beforeFE--            opInner        = op  `plusPtr` reservedBefore-            opeInner       = ope `plusPtr` (-reservedAfter)-            brInner        = BufferRange opInner opeInner--            wrapChunk :: Ptr Word8 -> IO (Ptr Word8)-            wrapChunk !opInner'-              | innerSize == 0 = return op -- no data written => no chunk to wrap-              | otherwise      = do-                  runF beforeFE innerSize op-                  runB afterBE innerSize opInner'-              where-                innerSize = fromIntegral $ opInner' `minusPtr` opInner--            doneH opInner' x = do-                op' <- wrapChunk opInner'-                let !br' = BufferRange op' ope-                k x br'--            fullH opInner' minSize nextInnerStep = do-                op' <- wrapChunk opInner'-                return $! bufferFull-                  (max minBufferSize (minSize + maxReserved))-                  op'-                  (fill nextInnerStep)--            insertChunksH opInner' n lbsC nextInnerStep-              | n == 0 = do                      -- flush-                  op' <- wrapChunk opInner'-                  return $! insertChunks op' 0 id (fill nextInnerStep)--              | otherwise = do                   -- insert non-empty bytestring-                  op' <- wrapChunk opInner'-                  let !br' = BufferRange op' ope-                  runBuilderWith chunkB (fill nextInnerStep) br'-              where-                nU     = fromIntegral n-                chunkB =-                  encodeWithF (mkBeforeFE nU) nU `mappend`-                  lazyByteStringC n lbsC         `mappend`-                  encodeWithB afterBE nU----- | /Heavy inlining./ Prefix a 'Builder' with the size of the--- sequence of bytes that it denotes.------ This function is optimized for streaming use. It tries to prefix the size--- without copying the output. This is achieved by reserving space for the--- maximum size to be encoded. This succeeds if the output is smaller than--- the current free buffer size, which is guaranteed to be at least @8kb@.------ If the output does not fit into the current free buffer size,--- the method falls back to encoding the data to a separate lazy bytestring,--- computing the size, and encoding the size before inserting the chunks of--- the separate lazy bytestring.-{-# INLINE encodeWithSize #-}-encodeWithSize-    ::-       Word-    -- ^ Inner buffer-size.-    -> (Word64 -> FixedEncoding Word64)-    -- ^ Given a bound on the maximal size to encode, this function must return-    -- a fixed-size encoding for all smaller sizes.-    -> Builder-    -- ^ 'Put' to prefix with the length of its sequence of bytes.-    -> Builder-encodeWithSize innerBufSize mkSizeFE =-    fromPut . putWithSize innerBufSize mkSizeFE . putBuilder---- | Prefix a 'Put' with the size of its written data.-{-# INLINE putWithSize #-}-putWithSize-    :: forall a.-       Word-    -- ^ Buffer-size for inner driver.-    -> (Word64 -> FixedEncoding Word64)-    -- ^ Encoding the size for the fallback case.-    -> Put a-    -- ^ 'Put' to prefix with the length of its sequence of bytes.-    -> Put a-putWithSize innerBufSize mkSizeFE innerP =-    put $ encodingStep-  where-    -- | The minimal free size is such that we can encode any size.-    minFree = I.size $ mkSizeFE maxBound--    encodingStep :: (forall r. (a -> BuildStep r) -> BuildStep r)-    encodingStep k =-        fill (runPut innerP)-      where-        fill :: BuildStep a -> BufferRange -> IO (BuildSignal r)-        fill innerStep !(BufferRange op ope)-          | outRemaining < minFree =-              return $! bufferFull minFree op (fill innerStep)-          | otherwise = do-              fillWithBuildStep innerStep doneH fullH insertChunksH brInner-          where-            outRemaining   = ope `minusPtr` op-            sizeFE         = mkSizeFE $ fromIntegral outRemaining-            reservedBefore = I.size sizeFE-            reservedAfter  = minFree - reservedBefore--            -- leave enough free space such that all sizes can be encodded.-            startInner    = op  `plusPtr` reservedBefore-            opeInner      = ope `plusPtr` (negate reservedAfter)-            brInner       = BufferRange startInner opeInner--            fastPrefixSize :: Ptr Word8 -> IO (Ptr Word8)-            fastPrefixSize !opInner'-              | innerSize == 0 = do runB (toB $ mkSizeFE 0) 0         op-              | otherwise      = do runF (sizeFE)           innerSize op-                                    return opInner'-              where-                innerSize = fromIntegral $ opInner' `minusPtr` startInner--            slowPrefixSize :: Ptr Word8 -> Builder -> BuildStep a -> IO (BuildSignal r)-            slowPrefixSize opInner' bInner nextStep = do-                (x, chunks, payLenChunks) <- toLBS $ runBuilderWith bInner nextStep--                let -- length of payload data in current buffer-                    payLenCur   = opInner' `minusPtr` startInner-                    -- length of whole payload-                    payLen      = fromIntegral payLenCur + fromIntegral payLenChunks-                    -- encoder for payload length-                    sizeFE'     = mkSizeFE payLen-                    -- start of payload in current buffer with the payload-                    -- length encoded before-                    startInner' = op `plusPtr` I.size sizeFE'--                -- move data in current buffer out of the way, if required-                unless (startInner == startInner') $-                    moveBytes startInner' startInner payLenCur-                -- encode payload length at start of the buffer-                runF sizeFE' payLen op-                -- TODO: If we were to change the CIOS definition such that it also-                -- returns the last buffer for writing, we could also fill the-                -- last buffer with 'k' and return the signal, once it is-                -- filled, therefore avoiding unfilled space.-                return $ insertChunks (startInner' `plusPtr` payLenCur)-                                      payLenChunks-                                      chunks-                                      (k x)-              where-                toLBS = runCIOSWithLength <=<-                    buildStepToCIOSUntrimmedWith (fromIntegral innerBufSize)--            doneH :: Ptr Word8 -> a -> IO (BuildSignal r)-            doneH opInner' x = do-                op' <- fastPrefixSize opInner'-                let !br' = BufferRange op' ope-                k x br'--            fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (BuildSignal r)-            fullH opInner' minSize nextInnerStep =-                slowPrefixSize opInner' (ensureFree minSize) nextInnerStep--            insertChunksH :: Ptr Word8 -> Int64 -> LazyByteStringC-                          -> BuildStep a -> IO (BuildSignal r)-            insertChunksH opInner' n lbsC nextInnerStep =-                slowPrefixSize opInner' (lazyByteStringC n lbsC) nextInnerStep----- | Run a 'ChunkIOStream' and gather its results and their length.-runCIOSWithLength :: ChunkIOStream a -> IO (a, LazyByteStringC, Int64)-runCIOSWithLength =-    go 0 id-  where-    go !l lbsC (Finished x)        = return (x, lbsC, l)-    go !l lbsC (YieldC n lbsC' io) = io >>= go (l + n) (lbsC . lbsC')-    go !l lbsC (Yield1 bs io)      =-        io >>= go (l + fromIntegral (S.length bs)) (lbsC . L.Chunk bs)---- | Run a 'BuildStep' using the untrimmed strategy.-buildStepToCIOSUntrimmedWith :: Int -> BuildStep a -> IO (ChunkIOStream a)-buildStepToCIOSUntrimmedWith bufSize =-    buildStepToCIOS (untrimmedStrategy bufSize bufSize)-                    (return . Finished)---------------------------------------------------------------------------- Padded versions of encodings for streamed prefixing of output sizes-------------------------------------------------------------------------{-# INLINE appsUntilZero #-}-appsUntilZero :: (Eq a, Num a) => (a -> a) -> a -> Int-appsUntilZero f x0 =-    count 0 x0-  where-    count !n 0 = n-    count !n x = count (succ n) (f x)---{-# INLINE genericVarFixedBound #-}-genericVarFixedBound :: (Eq b, Show b, Bits b, Num a, Integral b)-                => (b -> a -> b) -> b -> FixedEncoding b-genericVarFixedBound shiftRight bound =-    fixedEncoding n0 io-  where-    n0 = max 1 $ appsUntilZero (`shiftRight` 7) bound--    io !x0 !op-      | x0 > bound = error err-      | otherwise  = loop 0 x0-      where-        err = "genericVarFixedBound: value " ++ show x0 ++ " > bound " ++ show bound-        loop !n !x-          | n0 <= n + 1 = do poke8 (x .&. 0x7f)-          | otherwise   = do poke8 ((x .&. 0x7f) .|. 0x80)-                             loop (n + 1) (x `shiftRight` 7)-          where-            poke8 = pokeElemOff op n . fromIntegral--{-# INLINE wordVarFixedBound #-}-wordVarFixedBound :: Word -> FixedEncoding Word-wordVarFixedBound = genericVarFixedBound shiftr_w--{-# INLINE word64VarFixedBound #-}-word64VarFixedBound :: Word64 -> FixedEncoding Word64-word64VarFixedBound = genericVarFixedBound shiftr_w64----- Somehow this function doesn't really make sense, as the bound must be--- greater when interpreted as an unsigned integer. These conversions and--- decisions should be left to the user.------{-# INLINE intVarFixed #-}---intVarFixed :: Size -> FixedEncoding Size---intVarFixed bound = fromIntegral >$< wordVarFixed (fromIntegral bound)--{-# INLINE genHexFixedBound #-}-genHexFixedBound :: (Num a, Bits a, Integral a)-                 => (a -> Int -> a) -> Char -> a -> FixedEncoding a-genHexFixedBound shiftr padding0 bound =-    fixedEncoding n0 io-  where-    n0 = max 1 $ appsUntilZero (`shiftr` 4) bound--    padding = fromIntegral (ord padding0) :: Word8--    io !x0 !op0 =-        loop (op0 `plusPtr` n0) x0-      where-        loop !op !x = do-           let !op' = op `plusPtr` (-1)-           poke op' =<< encode4_as_8 lowerTable (fromIntegral $ x .&. 0xf)-           let !x' = x `shiftr` 4-           unless (op' <= op0) $-             if x' == 0-               then pad (op' `plusPtr` (-1))-               else loop op' x'--        pad !op-          | op < op0  = return ()-          | otherwise = poke op padding >> pad (op `plusPtr` (-1))---{-# INLINE wordHexFixedBound #-}-wordHexFixedBound :: Char -> Word -> FixedEncoding Word-wordHexFixedBound = genHexFixedBound shiftr_w--{-# INLINE word64HexFixedBound #-}-word64HexFixedBound :: Char -> Word64 -> FixedEncoding Word64-word64HexFixedBound = genHexFixedBound shiftr_w64---- | Note: Works only for positive numbers.-{-# INLINE genDecFixedBound #-}-genDecFixedBound :: (Num a, Bits a, Integral a)-                 => Char -> a -> FixedEncoding a-genDecFixedBound padding0 bound =-    fixedEncoding n0 io-  where-    n0 = max 1 $ appsUntilZero (`div` 10) bound--    padding = fromIntegral (ord padding0) :: Word8--    io !x0 !op0 =-        loop (op0 `plusPtr` n0) x0-      where-        loop !op !x = do-           let !op' = op `plusPtr` (-1)-               !x'  = x `div` 10-           poke op' ((fromIntegral $ (x - x' * 10) + 48) :: Word8)-           unless (op' <= op0) $-             if x' == 0-               then pad (op' `plusPtr` (-1))-               else loop op' x'--        pad !op-          | op < op0  = return ()-          | otherwise = poke op padding >> pad (op `plusPtr` (-1))--{-# INLINE wordDecFixedBound #-}-wordDecFixedBound :: Char -> Word -> FixedEncoding Word-wordDecFixedBound = genDecFixedBound--{-# INLINE word64DecFixedBound #-}-word64DecFixedBound :: Char -> Word64 -> FixedEncoding Word64-word64DecFixedBound = genDecFixedBound-