bsb-http-chunked (empty) → 0
raw patch · 13 files changed
+1779/−0 lines, 13 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, blaze-builder, bytestring, bytestring-builder, deepseq, test-framework, test-framework-hunit, test-framework-quickcheck2, text, utf8-string
Files
- Blaze/ByteString/Builder.hs +258/−0
- Blaze/ByteString/Builder/ByteString.hs +128/−0
- Blaze/ByteString/Builder/Char8.hs +69/−0
- Blaze/ByteString/Builder/Compat/Write.hs +30/−0
- Blaze/ByteString/Builder/Int.hs +258/−0
- Blaze/ByteString/Builder/Internal/Write.hs +313/−0
- Blaze/ByteString/Builder/Word.hs +268/−0
- Data/ByteString/Builder/HTTP/Chunked.hs +202/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- bsb-http-chunked.cabal +74/−0
- tests/LlvmSegfault.hs +35/−0
- tests/Tests.hs +112/−0
+ Blaze/ByteString/Builder.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE CPP, BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- "Blaze.ByteString.Builder" is the main module, which you should import as a user+-- of the @blaze-builder@ library.+--+-- > import Blaze.ByteString.Builder+--+-- It provides you with a type 'Builder' that allows to efficiently construct+-- lazy bytestrings with a large average chunk size.+--+-- Intuitively, a 'Builder' denotes the construction of a part of a lazy+-- bytestring. Builders can either be created using one of the primitive+-- combinators in "Blaze.ByteString.Builder.Write" or by using one of the predefined+-- combinators for standard Haskell values (see the exposed modules of this+-- package). Concatenation of builders is done using 'mappend' from the+-- 'Monoid' typeclass.+--+-- Here is a small example that serializes a list of strings using the UTF-8+-- encoding.+--+-- @ import "Blaze.ByteString.Builder.Char.Utf8"@+--+-- > strings :: [String]+-- > strings = replicate 10000 "Hello there!"+--+-- The function @'fromString'@ creates a 'Builder' denoting the UTF-8 encoded+-- argument. Hence, UTF-8 encoding and concatenating all @strings@ can be done+-- follows.+--+-- > concatenation :: Builder+-- > concatenation = mconcat $ map fromString strings+--+-- The function 'toLazyByteString' can be used to execute a 'Builder' and+-- obtain the resulting lazy bytestring.+--+-- > result :: L.ByteString+-- > result = toLazyByteString concatenation+--+-- The @result@ is a lazy bytestring containing 10000 repetitions of the string+-- @\"Hello there!\"@ encoded using UTF-8. The corresponding 120000 bytes are+-- distributed among three chunks of 32kb and a last chunk of 6kb.+--+-- /A note on history./ This serialization library was inspired by the+-- @Data.Binary.Builder@ module provided by the @binary@ package. It was+-- originally developed with the specific needs of the @blaze-html@ package in+-- mind. Since then it has been restructured to serve as a drop-in replacement+-- for @Data.Binary.Builder@, which it improves upon both in speed as well as+-- expressivity.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder+ (+ -- * The 'Builder' type+ B.Builder++ -- * Creating builders+ , module Blaze.ByteString.Builder.Int+ , module Blaze.ByteString.Builder.Word+ , module Blaze.ByteString.Builder.ByteString+ , B.flush++ -- * Executing builders+ , B.toLazyByteString+ , toLazyByteStringWith+ , toByteString+ , toByteStringIO+ , toByteStringIOWith++ -- * 'Write's+ , W.Write+ , W.fromWrite+ , W.fromWriteSingleton+ , W.fromWriteList+ , writeToByteString++ -- ** Writing 'Storable's+ , W.writeStorable+ , W.fromStorable+ , W.fromStorables++ ) where++import Control.Monad(unless)++#if __GLASGOW_HASKELL__ >= 702+import Foreign+import qualified Foreign.ForeignPtr.Unsafe as Unsafe+#else+import Foreign as Unsafe+#endif++import qualified Blaze.ByteString.Builder.Internal.Write as W+import Blaze.ByteString.Builder.ByteString+import Blaze.ByteString.Builder.Word+import Blaze.ByteString.Builder.Int++import Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B++import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L++#if __GLASGOW_HASKELL__ >= 702+import System.IO.Unsafe (unsafeDupablePerformIO)+#else+unsafeDupablePerformIO :: IO a -> a+unsafeDupablePerformIO = unsafePerformIO+#endif++++-- | Pack the chunks of a lazy bytestring into a single strict bytestring.+packChunks :: L.ByteString -> S.ByteString+packChunks lbs = do+ S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)+ where+ copyChunks !L.Empty !_pf = return ()+ copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do+ withForeignPtr fpbuf $ \pbuf ->+ copyBytes pf (pbuf `plusPtr` o) l+ copyChunks lbs' (pf `plusPtr` l)++-- | Run the builder to construct a strict bytestring containing the sequence+-- of bytes denoted by the builder. This is done by first serializing to a lazy bytestring and then packing its+-- chunks to a appropriately sized strict bytestring.+--+-- > toByteString = packChunks . toLazyByteString+--+-- Note that @'toByteString'@ is a 'Monoid' homomorphism.+--+-- > toByteString mempty == mempty+-- > toByteString (x `mappend` y) == toByteString x `mappend` toByteString y+--+-- However, in the second equation, the left-hand-side is generally faster to+-- execute.+--+toByteString :: Builder -> S.ByteString+toByteString = packChunks . B.toLazyByteString++-- | Default size (~32kb) for the buffer that becomes a chunk of the output+-- stream once it is filled.+--+defaultBufferSize :: Int+defaultBufferSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy.+ where overhead = 2 * sizeOf (undefined :: Int)+++-- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of+-- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the+-- buffer is full.+--+-- Compared to 'toLazyByteStringWith' this function requires less allocation,+-- as the output buffer is only allocated once at the start of the+-- serialization and whenever something bigger than the current buffer size has+-- to be copied into the buffer, which should happen very seldomly for the+-- default buffer size of 32kb. Hence, the pressure on the garbage collector is+-- reduced, which can be an advantage when building long sequences of bytes.+--+toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO ()+toByteStringIO = toByteStringIOWith defaultBufferSize++toByteStringIOWith :: Int -- ^ Buffer size (upper bounds+ -- the number of bytes forced+ -- per call to the 'IO' action).+ -> (S.ByteString -> IO ()) -- ^ 'IO' action to execute per+ -- full buffer, which is+ -- referenced by a strict+ -- 'S.ByteString'.+ -> Builder -- ^ 'Builder' to run.+ -> IO () -- ^ Resulting 'IO' action.+toByteStringIOWith !bufSize io builder = do+ S.mallocByteString bufSize >>= getBuffer (B.runBuilder builder) bufSize+ where+ getBuffer writer !size fp = do+ let !ptr = Unsafe.unsafeForeignPtrToPtr fp+ (bytes, next) <- writer ptr size+ case next of+ B.Done -> io $! S.PS fp 0 bytes+ B.More req writer' -> do+ io $! S.PS fp 0 bytes+ let !size' = max bufSize req+ S.mallocByteString size' >>= getBuffer writer' size'+ B.Chunk bs' writer' -> do+ if bytes > 0+ then do+ io $! S.PS fp 0 bytes+ unless (S.null bs') (io bs')+ S.mallocByteString bufSize >>= getBuffer writer' bufSize+ else do+ unless (S.null bs') (io bs')+ getBuffer writer' size fp+++-- | Run a 'Builder' with the given buffer sizes.+--+-- Use this function for integrating the 'Builder' type with other libraries+-- that generate lazy bytestrings.+--+-- Note that the builders should guarantee that on average the desired chunk+-- size is attained. Builders may decide to start a new buffer and not+-- completely fill the existing buffer, if this is faster. However, they should+-- not spill too much of the buffer, if they cannot compensate for it.+--+-- FIXME: Note that the following paragraphs are not entirely correct as of+-- blaze-builder-0.4:+--+-- A call @toLazyByteStringWith bufSize minBufSize firstBufSize@ will generate+-- a lazy bytestring according to the following strategy. First, we allocate+-- a buffer of size @firstBufSize@ and start filling it. If it overflows, we+-- allocate a buffer of size @minBufSize@ and copy the first buffer to it in+-- order to avoid generating a too small chunk. Finally, every next buffer will+-- be of size @bufSize@. This, slow startup strategy is required to achieve+-- good speed for short (<200 bytes) resulting bytestrings, as for them the+-- allocation cost is of a large buffer cannot be compensated. Moreover, this+-- strategy also allows us to avoid spilling too much memory for short+-- resulting bytestrings.+--+-- Note that setting @firstBufSize >= minBufSize@ implies that the first buffer+-- is no longer copied but allocated and filled directly. Hence, setting+-- @firstBufSize = bufSize@ means that all chunks will use an underlying buffer+-- of size @bufSize@. This is recommended, if you know that you always output+-- more than @minBufSize@ bytes.+toLazyByteStringWith+ :: Int -- ^ Buffer size (upper-bounds the resulting chunk size).+ -> Int -- ^ This parameter is ignored as of blaze-builder-0.4+ -> Int -- ^ Size of the first buffer to be used and copied for+ -- larger resulting sequences+ -> Builder -- ^ Builder to run.+ -> L.ByteString -- ^ Lazy bytestring to output after the builder is+ -- finished.+ -> L.ByteString -- ^ Resulting lazy bytestring+toLazyByteStringWith bufSize _minBufSize firstBufSize builder k =+ B.toLazyByteStringWith (B.safeStrategy firstBufSize bufSize) k builder++-- | Run a 'Write' to produce a strict 'S.ByteString'.+-- This is equivalent to @('toByteString' . 'fromWrite')@, but is more+-- efficient because it uses just one appropriately-sized buffer.+writeToByteString :: W.Write -> S.ByteString+writeToByteString !w = unsafeDupablePerformIO $ do+ fptr <- S.mallocByteString (W.getBound w)+ len <- withForeignPtr fptr $ \ptr -> do+ end <- W.runWrite w ptr+ return $! end `minusPtr` ptr+ return $! S.fromForeignPtr fptr 0 len+{-# INLINE writeToByteString #-}
+ Blaze/ByteString/Builder/ByteString.hs view
@@ -0,0 +1,128 @@+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.ByteString+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- 'Write's and 'B.Builder's for strict and lazy bytestrings.+--+-- We assume the following qualified imports in order to differentiate between+-- strict and lazy bytestrings in the code examples.+--+-- > import qualified Data.ByteString as S+-- > import qualified Data.ByteString.Lazy as L+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.ByteString+ (+ -- * Strict bytestrings+ writeByteString+ , fromByteString+ , fromByteStringWith+ , copyByteString+ , insertByteString++ -- * Lazy bytestrings+ , fromLazyByteString+ , fromLazyByteStringWith+ , copyLazyByteString+ , insertLazyByteString++ ) where+++import Blaze.ByteString.Builder.Internal.Write ( Write, exactWrite )+import Foreign+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L+++-- | Write a strict 'S.ByteString' to a buffer.+writeByteString :: S.ByteString -> Write+writeByteString bs = exactWrite l io+ where+ (fptr, o, l) = S.toForeignPtr bs+ io pf = withForeignPtr fptr $ \p -> copyBytes pf (p `plusPtr` o) l+{-# INLINE writeByteString #-}++-- | Create a 'B.Builder' denoting the same sequence of bytes as a strict+-- 'S.ByteString'.+-- The 'B.Builder' inserts large 'S.ByteString's directly, but copies small ones+-- to ensure that the generated chunks are large on average.+fromByteString :: S.ByteString -> B.Builder+fromByteString = B.byteString+{-# INLINE fromByteString #-}+++-- | Construct a 'B.Builder' that copies the strict 'S.ByteString's, if it is+-- smaller than the treshold, and inserts it directly otherwise.+--+-- For example, @fromByteStringWith 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.+--+fromByteStringWith :: Int -- ^ Maximal number of bytes to copy.+ -> S.ByteString -- ^ Strict 'S.ByteString' to serialize.+ -> B.Builder -- ^ Resulting 'B.Builder'.+fromByteStringWith = B.byteStringThreshold+{-# INLINE fromByteStringWith #-}++-- | Construct a 'B.Builder' that copies the strict 'S.ByteString'.+--+-- Use this function to create 'B.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 'B.Builder'.+--+copyByteString :: S.ByteString -> B.Builder+copyByteString = B.byteStringCopy+{-# INLINE copyByteString #-}++-- | Construct a 'B.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 'insertByteString' only for large+-- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too+-- fragmented to be processed efficiently afterwards.+--+insertByteString :: S.ByteString -> B.Builder+insertByteString = B.byteStringInsert+{-# INLINE insertByteString #-}++-- | Create a 'B.Builder' denoting the same sequence of bytes as a lazy+-- 'S.ByteString'.+-- The 'B.Builder' inserts large chunks of the lazy 'L.ByteString' directly,+-- but copies small ones to ensure that the generated chunks are large on+-- average.+--+fromLazyByteString :: L.ByteString -> B.Builder+fromLazyByteString = B.lazyByteString+{-# INLINE fromLazyByteString #-}++-- | Construct a 'B.Builder' that uses the thresholding strategy of 'fromByteStringWith'+-- for each chunk of the lazy 'L.ByteString'.+--+fromLazyByteStringWith :: Int -> L.ByteString -> B.Builder+fromLazyByteStringWith = B.lazyByteStringThreshold+{-# INLINE fromLazyByteStringWith #-}++-- | Construct a 'B.Builder' that copies the lazy 'L.ByteString'.+--+copyLazyByteString :: L.ByteString -> B.Builder+copyLazyByteString = B.lazyByteStringCopy+{-# INLINE copyLazyByteString #-}++-- | Construct a 'B.Builder' that inserts all chunks of the lazy 'L.ByteString'+-- directly.+--+insertLazyByteString :: L.ByteString -> B.Builder+insertLazyByteString = B.lazyByteStringInsert+{-# INLINE insertLazyByteString #-}
+ Blaze/ByteString/Builder/Char8.hs view
@@ -0,0 +1,69 @@+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.Char8+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- //Note:// This package is intended for low-level use like implementing+-- protocols. If you need to //serialize// Unicode characters use one of the+-- UTF encodings (e.g. 'Blaze.ByteString.Builder.Char.UTF-8').+--+-- 'Write's and 'Builder's for serializing the lower 8-bits of characters.+--+-- This corresponds to what the 'bytestring' package offer in+-- 'Data.ByteString.Char8'.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Char8+ (+ -- * Writing Latin-1 (ISO 8859-1) encodable characters to a buffer+ writeChar++ -- * Creating Builders from Latin-1 (ISO 8859-1) encodable characters+ , fromChar+ , fromString+ , fromShow+ , fromText+ , fromLazyText+ ) where++import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )+import Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL++-- | Write the lower 8-bits of a character to a buffer.+writeChar :: Char -> Write+writeChar = writePrimFixed P.char8+{-# INLINE writeChar #-}++-- | /O(1)/. Serialize the lower 8-bits of a character.+fromChar :: Char -> Builder+fromChar = B.char8+{-# INLINE fromChar #-}++-- | /O(n)/. Serialize the lower 8-bits of all characters of a string+fromString :: String -> Builder+fromString = P.primMapListFixed P.char8+{-# INLINE fromString #-}++-- | /O(n)/. Serialize a value by 'Show'ing it and serializing the lower 8-bits+-- of the resulting string.+fromShow :: Show a => a -> Builder+fromShow = fromString . show+{-# INLINE fromShow #-}++-- | /O(n)/. Serialize the lower 8-bits of all characters in the strict text.+fromText :: TS.Text -> Builder+fromText = fromString . TS.unpack+{-# INLINE fromText #-}++-- | /O(n)/. Serialize the lower 8-bits of all characters in the lazy text.+fromLazyText :: TL.Text -> Builder+fromLazyText = fromString . TL.unpack+{-# INLINE fromLazyText #-}
+ Blaze/ByteString/Builder/Compat/Write.hs view
@@ -0,0 +1,30 @@+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.Compat.Write+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- Conversions from the new Prims to the old Writes.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Compat.Write+ ( Write+ , writePrimFixed+ , writePrimBounded+ ) where++import Data.ByteString.Builder.Prim.Internal (BoundedPrim, FixedPrim+ , runB, runF, size, sizeBound)+import Blaze.ByteString.Builder.Internal.Write (Poke(..), Write+ , boundedWrite, exactWrite)++writePrimFixed :: FixedPrim a -> a -> Write+writePrimFixed fe a = exactWrite (size fe) (runF fe a)+{-# INLINE writePrimFixed #-}++writePrimBounded :: BoundedPrim a -> a -> Write+writePrimBounded be a = boundedWrite (sizeBound be) (Poke (runB be a))+{-# INLINE writePrimBounded #-}
+ Blaze/ByteString/Builder/Int.hs view
@@ -0,0 +1,258 @@+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.Int+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- 'Write's and 'Builder's for serializing integers.+--+-- See "Blaze.ByteString.Builder.Word" for information about how to best write several+-- integers at once.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Int+ (+ -- * Writing integers to a buffer++ writeInt8++ -- ** Big-endian writes+ , writeInt16be -- :: Int16 -> Write+ , writeInt32be -- :: Int32 -> Write+ , writeInt64be -- :: Int64 -> Write++ -- ** Little-endian writes+ , writeInt16le -- :: Int16 -> Write+ , writeInt32le -- :: Int32 -> Write+ , writeInt64le -- :: Int64 -> Write++ -- ** Host-endian writes+ , writeInthost -- :: Int -> Write+ , writeInt16host -- :: Int16 -> Write+ , writeInt32host -- :: Int32 -> Write+ , writeInt64host -- :: Int64 -> Write++ -- * Creating builders from integers++ -- | We provide serialization functions both for singleton integers as well as+ -- for lists of integers. Using these list serialization functions is /much/ faster+ -- than using @mconcat . map fromInt/<n/>@, as the list serialization+ -- functions use a tighter inner loop.++ , fromInt8+ , fromInt8s++ -- ** Big-endian serialization+ , fromInt16be -- :: Int16 -> Builder+ , fromInt32be -- :: Int32 -> Builder+ , fromInt64be -- :: Int64 -> Builder+ , fromInt32sbe -- :: [Int32] -> Builder+ , fromInt16sbe -- :: [Int16] -> Builder+ , fromInt64sbe -- :: [Int64] -> Builder++ -- ** Little-endian serialization+ , fromInt16le -- :: Int16 -> Builder+ , fromInt32le -- :: Int32 -> Builder+ , fromInt64le -- :: Int64 -> Builder+ , fromInt16sle -- :: [Int16] -> Builder+ , fromInt32sle -- :: [Int32] -> Builder+ , fromInt64sle -- :: [Int64] -> Builder++ -- ** Host-endian serialization+ , fromInthost -- :: Int -> Builder+ , fromInt16host -- :: Int16 -> Builder+ , fromInt32host -- :: Int32 -> Builder+ , fromInt64host -- :: Int64 -> Builder+ , fromIntshost -- :: [Int] -> Builder+ , fromInt16shost -- :: [Int16] -> Builder+ , fromInt32shost -- :: [Int32] -> Builder+ , fromInt64shost -- :: [Int64] -> Builder++ ) where++import Data.Int+import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )+import Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString.Builder.Prim as P++-- | Write a single signed byte.+--+writeInt8 :: Int8 -> Write+writeInt8 = writePrimFixed P.int8+{-# INLINE writeInt8 #-}++-- | Write an 'Int16' in big endian format.+writeInt16be :: Int16 -> Write+writeInt16be = writePrimFixed P.int16BE+{-# INLINE writeInt16be #-}++-- | Write an 'Int32' in big endian format.+writeInt32be :: Int32 -> Write+writeInt32be = writePrimFixed P.int32BE+{-# INLINE writeInt32be #-}++-- | Write an 'Int64' in big endian format.+writeInt64be :: Int64 -> Write+writeInt64be = writePrimFixed P.int64BE+{-# INLINE writeInt64be #-}++-- | Write an 'Int16' in little endian format.+writeInt16le :: Int16 -> Write+writeInt16le = writePrimFixed P.int16LE+{-# INLINE writeInt16le #-}++-- | Write an 'Int32' in little endian format.+writeInt32le :: Int32 -> Write+writeInt32le = writePrimFixed P.int32LE+{-# INLINE writeInt32le #-}++-- | Write an 'Int64' in little endian format.+writeInt64le :: Int64 -> Write+writeInt64le = writePrimFixed P.int64LE+{-# INLINE writeInt64le #-}++-- | Write a single native machine 'Int'. The 'Int' is written in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Int'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this way+-- are not portable to different endian or integer sized machines, without+-- conversion.+--+writeInthost :: Int -> Write+writeInthost = writePrimFixed P.intHost+{-# INLINE writeInthost #-}++-- | Write an 'Int16' in native host order and host endianness.+writeInt16host :: Int16 -> Write+writeInt16host = writePrimFixed P.int16Host+{-# INLINE writeInt16host #-}++-- | Write an 'Int32' in native host order and host endianness.+writeInt32host :: Int32 -> Write+writeInt32host = writePrimFixed P.int32Host+{-# INLINE writeInt32host #-}++-- | Write an 'Int64' in native host order and host endianness.+writeInt64host :: Int64 -> Write+writeInt64host = writePrimFixed P.int64Host+{-# INLINE writeInt64host #-}++-- | Serialize a single byte.+fromInt8 :: Int8 -> Builder+fromInt8 = B.int8+{-# INLINE fromInt8 #-}++-- | Serialize a list of bytes.+fromInt8s :: [Int8] -> Builder+fromInt8s = P.primMapListFixed P.int8+{-# INLINE fromInt8s #-}++-- | Serialize an 'Int16' in big endian format.+fromInt16be :: Int16 -> Builder+fromInt16be = B.int16BE+{-# INLINE fromInt16be #-}++-- | Serialize an 'Int32' in big endian format.+fromInt32be :: Int32 -> Builder+fromInt32be = B.int32BE+{-# INLINE fromInt32be #-}++-- | Serialize an 'Int64' in big endian format.+fromInt64be :: Int64 -> Builder+fromInt64be = B.int64BE+{-# INLINE fromInt64be #-}++-- | Serialize a list of 'Int32's in big endian format.+fromInt32sbe :: [Int32] -> Builder+fromInt32sbe = P.primMapListFixed P.int32BE+{-# INLINE fromInt32sbe #-}++-- | Serialize a list of 'Int16's in big endian format.+fromInt16sbe :: [Int16] -> Builder+fromInt16sbe = P.primMapListFixed P.int16BE+{-# INLINE fromInt16sbe #-}++-- | Serialize a list of 'Int64's in big endian format.+fromInt64sbe :: [Int64] -> Builder+fromInt64sbe = P.primMapListFixed P.int64BE+{-# INLINE fromInt64sbe #-}++-- | Serialize an 'Int16' in little endian format.+fromInt16le :: Int16 -> Builder+fromInt16le = B.int16LE+{-# INLINE fromInt16le #-}++-- | Serialize an 'Int32' in little endian format.+fromInt32le :: Int32 -> Builder+fromInt32le = B.int32LE+{-# INLINE fromInt32le #-}++-- | Serialize an 'Int64' in little endian format.+fromInt64le :: Int64 -> Builder+fromInt64le = B.int64LE+{-# INLINE fromInt64le #-}++-- | Serialize a list of 'Int16's in little endian format.+fromInt16sle :: [Int16] -> Builder+fromInt16sle = P.primMapListFixed P.int16LE+{-# INLINE fromInt16sle #-}++-- | Serialize a list of 'Int32's in little endian format.+fromInt32sle :: [Int32] -> Builder+fromInt32sle = P.primMapListFixed P.int32LE+{-# INLINE fromInt32sle #-}++-- | Serialize a list of 'Int64's in little endian format.+fromInt64sle :: [Int64] -> Builder+fromInt64sle = P.primMapListFixed P.int64LE+{-# INLINE fromInt64sle #-}++-- | Serialize a single native machine 'Int'. The 'Int' is serialized in host+-- order, host endian form, for the machine you're on. On a 64 bit machine the+-- 'Int' is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this+-- way are not portable to different endian or integer sized machines, without+-- conversion.+--+fromInthost :: Int -> Builder+fromInthost = B.intHost+{-# INLINE fromInthost #-}++-- | Write an 'Int16' in native host order and host endianness.+fromInt16host :: Int16 -> Builder+fromInt16host = B.int16Host+{-# INLINE fromInt16host #-}++-- | Write an 'Int32' in native host order and host endianness.+fromInt32host :: Int32 -> Builder+fromInt32host = B.int32Host+{-# INLINE fromInt32host #-}++-- | Write an 'Int64' in native host order and host endianness.+fromInt64host :: Int64 -> Builder+fromInt64host = B.int64Host+{-# INLINE fromInt64host #-}++-- | Serialize a list of 'Int's.+-- See 'fromInthost' for usage considerations.+fromIntshost :: [Int] -> Builder+fromIntshost = P.primMapListFixed P.intHost+{-# INLINE fromIntshost #-}++-- | Write a list of 'Int16's in native host order and host endianness.+fromInt16shost :: [Int16] -> Builder+fromInt16shost = P.primMapListFixed P.int16Host+{-# INLINE fromInt16shost #-}++-- | Write a list of 'Int32's in native host order and host endianness.+fromInt32shost :: [Int32] -> Builder+fromInt32shost = P.primMapListFixed P.int32Host+{-# INLINE fromInt32shost #-}++-- | Write a list of 'Int64's in native host order and host endianness.+fromInt64shost :: [Int64] -> Builder+fromInt64shost = P.primMapListFixed P.int64Host+{-# INLINE fromInt64shost #-}
+ Blaze/ByteString/Builder/Internal/Write.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE CPP, BangPatterns #-}++-- |+-- Module : Blaze.ByteString.Builder.Internal.Poke+-- Copyright : (c) 2010 Simon Meier+-- (c) 2010 Jasper van der Jeugt+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Leon Smith <leon@melding-monads.com>+-- Stability : experimental+-- Portability : tested on GHC only+--+-- A general and efficient write type that allows for the easy construction of+-- builders for (smallish) bounded size writes to a buffer.+--+-- FIXME: Improve documentation.+--+module Blaze.ByteString.Builder.Internal.Write (+ -- * Poking a buffer+ Poke(..)+ , pokeN++ -- * Writing to abuffer+ , Write(..)+ , runWrite+ , getBound+ , getBound'+ , getPoke++ , exactWrite+ , boundedWrite+ , writeLiftIO+ , writeIf+ , writeEq+ , writeOrdering+ , writeOrd++ -- * Constructing builders from writes+ , fromWrite+ , fromWriteSingleton+ , fromWriteList++ -- * Writing 'Storable's+ , writeStorable+ , fromStorable+ , fromStorables++ ) where++import Foreign++import Control.Monad++import Data.ByteString.Builder.Internal++import Data.Monoid (Monoid(..))+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#endif++import Prelude -- Silence redundant import warnings++------------------------------------------------------------------------------+-- Poking a buffer and writing to a buffer+------------------------------------------------------------------------------++-- Sadly GHC is not smart enough: code where we branch and each branch should+-- execute a few IO actions and then return a value cannot be taught to GHC. At+-- least not such that it returns the value of the branches unpacked.+--+-- Hmm.. at least he behaves much better for the Monoid instance of Write+-- than the one for Poke. Serializing UTF-8 chars gets a slowdown of a+-- factor 2 when 2 chars are composed. Perhaps I should try out the writeList+-- instances also, as they may be more sensitive to to much work per Char.+--++-- | Changing a sequence of bytes starting from the given pointer. 'Poke's are+-- the most primitive buffer manipulation. In most cases, you don't use the+-- explicitely but as part of a 'Write', which also tells how many bytes will+-- be changed at most.+newtype Poke =+ Poke { runPoke :: Ptr Word8 -> IO (Ptr Word8) }++-- | A write of a bounded number of bytes.+--+-- When defining a function @write :: a -> Write@ for some @a@, then it is+-- important to ensure that the bound on the number of bytes written is+-- data-independent. Formally,+--+-- @ forall x y. getBound (write x) = getBound (write y) @+--+-- The idea is that this data-independent bound is specified such that the+-- compiler can optimize the check, if there are enough free bytes in the buffer,+-- to a single subtraction between the pointer to the next free byte and the+-- pointer to the end of the buffer with this constant bound of the maximal+-- number of bytes to be written.+--+data Write = Write {-# UNPACK #-} !Int Poke++-- | Extract the 'Poke' action of a write.+{-# INLINE getPoke #-}+getPoke :: Write -> Poke+getPoke (Write _ wio) = wio++-- | Run the 'Poke' action of a write.+{-# INLINE runWrite #-}+runWrite :: Write -> Ptr Word8 -> IO (Ptr Word8)+runWrite = runPoke . getPoke++-- | Extract the maximal number of bytes that this write could write.+{-# INLINE getBound #-}+getBound :: Write -> Int+getBound (Write bound _) = bound++-- | Extract the maximal number of bytes that this write could write in any+-- case. Assumes that the bound of the write is data-independent.+{-# INLINE getBound' #-}+getBound' :: String -- ^ Name of caller: for debugging purposes.+ -> (a -> Write)+ -> Int+getBound' msg write =+ getBound $ write $ error $+ "getBound' called from " ++ msg ++ ": write bound is not data-independent."++#if MIN_VERSION_base(4,9,0)+instance Semigroup Poke where+ {-# INLINE (<>) #-}+ (Poke po1) <> (Poke po2) = Poke $ po1 >=> po2++ {-# INLINE sconcat #-}+ sconcat = foldr (<>) mempty+#endif++instance Monoid Poke where+ {-# INLINE mempty #-}+ mempty = Poke $ return++#if !(MIN_VERSION_base(4,11,0))+ {-# INLINE mappend #-}+ (Poke po1) `mappend` (Poke po2) = Poke $ po1 >=> po2+#endif++ {-# INLINE mconcat #-}+ mconcat = foldr mappend mempty++#if MIN_VERSION_base(4,9,0)+instance Semigroup Write where+ {-# INLINE (<>) #-}+ (Write bound1 w1) <> (Write bound2 w2) =+ Write (bound1 + bound2) (w1 <> w2)++ {-# INLINE sconcat #-}+ sconcat = foldr (<>) mempty+#endif++instance Monoid Write where+ {-# INLINE mempty #-}+ mempty = Write 0 mempty++#if !(MIN_VERSION_base(4,11,0))+ {-# INLINE mappend #-}+ (Write bound1 w1) `mappend` (Write bound2 w2) =+ Write (bound1 + bound2) (w1 `mappend` w2)+#endif++ {-# INLINE mconcat #-}+ mconcat = foldr mappend mempty++-- | @pokeN size io@ creates a write that denotes the writing of @size@ bytes+-- to a buffer using the IO action @io@. Note that @io@ MUST write EXACTLY @size@+-- bytes to the buffer!+{-# INLINE pokeN #-}+pokeN :: Int+ -> (Ptr Word8 -> IO ()) -> Poke+pokeN size io = Poke $ \op -> io op >> (return $! (op `plusPtr` size))+++-- | @exactWrite size io@ creates a bounded write that can later be converted to+-- a builder that writes exactly @size@ bytes. Note that @io@ MUST write+-- EXACTLY @size@ bytes to the buffer!+{-# INLINE exactWrite #-}+exactWrite :: Int+ -> (Ptr Word8 -> IO ())+ -> Write+exactWrite size io = Write size (pokeN size io)++-- | @boundedWrite size write@ creates a bounded write from a @write@ that does+-- not write more than @size@ bytes.+{-# INLINE boundedWrite #-}+boundedWrite :: Int -> Poke -> Write+boundedWrite = Write++-- | @writeLiftIO io write@ creates a write executes the @io@ action to compute+-- the value that is then written.+{-# INLINE writeLiftIO #-}+writeLiftIO :: (a -> Write) -> IO a -> Write+writeLiftIO write io =+ Write (getBound' "writeLiftIO" write)+ (Poke $ \pf -> do x <- io; runWrite (write x) pf)++-- | @writeIf p wTrue wFalse x@ creates a 'Write' with a 'Poke' equal to @wTrue+-- x@, if @p x@ and equal to @wFalse x@ otherwise. The bound of this new+-- 'Write' is the maximum of the bounds for either 'Write'. This yields a data+-- independent bound, if the bound for @wTrue@ and @wFalse@ is already data+-- independent.+{-# INLINE writeIf #-}+writeIf :: (a -> Bool) -> (a -> Write) -> (a -> Write) -> (a -> Write)+writeIf p wTrue wFalse x =+ boundedWrite (max (getBound $ wTrue x) (getBound $ wFalse x))+ (if p x then getPoke $ wTrue x else getPoke $ wFalse x)++-- | Compare the value to a test value and use the first write action for the+-- equal case and the second write action for the non-equal case.+{-# INLINE writeEq #-}+writeEq :: Eq a => a -> (a -> Write) -> (a -> Write) -> (a -> Write)+writeEq test = writeIf (test ==)++-- | TODO: Test this. It might well be too difficult to use.+-- FIXME: Better name required!+{-# INLINE writeOrdering #-}+writeOrdering :: (a -> Ordering)+ -> (a -> Write) -> (a -> Write) -> (a -> Write)+ -> (a -> Write)+writeOrdering ord wLT wEQ wGT x =+ boundedWrite bound (case ord x of LT -> getPoke $ wLT x;+ EQ -> getPoke $ wEQ x;+ GT -> getPoke $ wGT x)+ where+ bound = max (getBound $ wLT x) (max (getBound $ wEQ x) (getBound $ wGT x))++-- | A write combinator useful to build decision trees for deciding what value+-- to write with a constant bound on the maximal number of bytes written.+{-# INLINE writeOrd #-}+writeOrd :: Ord a+ => a+ -> (a -> Write) -> (a -> Write) -> (a -> Write)+ -> (a -> Write)+writeOrd test = writeOrdering (`compare` test)++-- | Create a builder that execute a single 'Write'.+{-# INLINE fromWrite #-}+fromWrite :: Write -> Builder+fromWrite (Write maxSize wio) =+ builder step+ where+ step k (BufferRange op ope)+ | op `plusPtr` maxSize <= ope = do+ op' <- runPoke wio op+ let !br' = BufferRange op' ope+ k br'+ | otherwise = return $ bufferFull maxSize op (step k)++{-# INLINE fromWriteSingleton #-}+fromWriteSingleton :: (a -> Write) -> (a -> Builder)+fromWriteSingleton write =+ mkBuilder+ where+ mkBuilder x = builder step+ where+ step k (BufferRange op ope)+ | op `plusPtr` maxSize <= ope = do+ op' <- runPoke wio op+ let !br' = BufferRange op' ope+ k br'+ | otherwise = return $ bufferFull maxSize op (step k)+ where+ Write maxSize wio = write x+++-- | Construct a 'Builder' writing a list of data one element at a time.+fromWriteList :: (a -> Write) -> [a] -> Builder+fromWriteList write =+ makeBuilder+ where+ 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` maxSize <= ope0 = do+ !op' <- runPoke wio op+ go xs' op'+ | otherwise = return $ bufferFull maxSize op (step xs k)+ where+ Write maxSize wio = write x'+{-# INLINE fromWriteList #-}++++------------------------------------------------------------------------------+-- Writing storables+------------------------------------------------------------------------------+++-- | Write a storable value.+{-# INLINE writeStorable #-}+writeStorable :: Storable a => a -> Write+writeStorable x = exactWrite (sizeOf x) (\op -> poke (castPtr op) x)++-- | A builder that serializes a storable value. No alignment is done.+{-# INLINE fromStorable #-}+fromStorable :: Storable a => a -> Builder+fromStorable = fromWriteSingleton writeStorable++-- | A builder that serializes a list of storable values by writing them+-- consecutively. No alignment is done. Parsing information needs to be+-- provided externally.+fromStorables :: Storable a => [a] -> Builder+fromStorables = fromWriteList writeStorable
+ Blaze/ByteString/Builder/Word.hs view
@@ -0,0 +1,268 @@+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.Word+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- 'Write's and 'Builder's for serializing words.+--+-- Note that for serializing a three tuple @(x,y,z)@ of bytes (or other word+-- values) you should use the expression+--+-- > fromWrite $ writeWord8 x `mappend` writeWord8 y `mappend` writeWord z+--+-- instead of+--+-- > fromWord8 x `mappend` fromWord8 y `mappend` fromWord z+--+-- The first expression will result in a single atomic write of three bytes,+-- while the second expression will check for each byte, if there is free space+-- left in the output buffer. Coalescing these checks can improve performance+-- quite a bit, as long as you use it sensibly.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Word+ (+ -- * Writing words to a buffer++ writeWord8++ -- ** Big-endian writes+ , writeWord16be -- :: Word16 -> Write+ , writeWord32be -- :: Word32 -> Write+ , writeWord64be -- :: Word64 -> Write++ -- ** Little-endian writes+ , writeWord16le -- :: Word16 -> Write+ , writeWord32le -- :: Word32 -> Write+ , writeWord64le -- :: Word64 -> Write++ -- ** Host-endian writes+ , writeWordhost -- :: Word -> Write+ , writeWord16host -- :: Word16 -> Write+ , writeWord32host -- :: Word32 -> Write+ , writeWord64host -- :: Word64 -> Write++ -- * Creating builders from words++ -- | We provide serialization functions both for singleton words as well as+ -- for lists of words. Using these list serialization functions is /much/ faster+ -- than using @mconcat . map fromWord/<n/>@, as the list serialization+ -- functions use a tighter inner loop.++ , fromWord8+ , fromWord8s++ -- ** Big-endian serialization+ , fromWord16be -- :: Word16 -> Builder+ , fromWord32be -- :: Word32 -> Builder+ , fromWord64be -- :: Word64 -> Builder+ , fromWord32sbe -- :: [Word32] -> Builder+ , fromWord16sbe -- :: [Word16] -> Builder+ , fromWord64sbe -- :: [Word64] -> Builder++ -- ** Little-endian serialization+ , fromWord16le -- :: Word16 -> Builder+ , fromWord32le -- :: Word32 -> Builder+ , fromWord64le -- :: Word64 -> Builder+ , fromWord16sle -- :: [Word16] -> Builder+ , fromWord32sle -- :: [Word32] -> Builder+ , fromWord64sle -- :: [Word64] -> Builder++ -- ** Host-endian serialization+ , fromWordhost -- :: Word -> Builder+ , fromWord16host -- :: Word16 -> Builder+ , fromWord32host -- :: Word32 -> Builder+ , fromWord64host -- :: Word64 -> Builder+ , fromWordshost -- :: [Word] -> Builder+ , fromWord16shost -- :: [Word16] -> Builder+ , fromWord32shost -- :: [Word32] -> Builder+ , fromWord64shost -- :: [Word64] -> Builder++ ) where++import Data.Word+import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )+import Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString.Builder.Prim as P++-- | Write a single byte.+--+writeWord8 :: Word8 -> Write+writeWord8 = writePrimFixed P.word8+{-# INLINE writeWord8 #-}++-- | Write a 'Word16' in big endian format.+writeWord16be :: Word16 -> Write+writeWord16be = writePrimFixed P.word16BE+{-# INLINE writeWord16be #-}++-- | Write a 'Word32' in big endian format.+writeWord32be :: Word32 -> Write+writeWord32be = writePrimFixed P.word32BE+{-# INLINE writeWord32be #-}++-- | Write a 'Word64' in big endian format.+writeWord64be :: Word64 -> Write+writeWord64be = writePrimFixed P.word64BE+{-# INLINE writeWord64be #-}++-- | Write a 'Word16' in little endian format.+writeWord16le :: Word16 -> Write+writeWord16le = writePrimFixed P.word16LE+{-# INLINE writeWord16le #-}++-- | Write a 'Word32' in big endian format.+writeWord32le :: Word32 -> Write+writeWord32le = writePrimFixed P.word32LE+{-# INLINE writeWord32le #-}++-- | Write a 'Word64' in little endian format.+writeWord64le :: Word64 -> Write+writeWord64le = writePrimFixed P.word64LE+{-# INLINE writeWord64le #-}++-- | Write a single native machine 'Word'. The 'Word' is written in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Word'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+writeWordhost :: Word -> Write+writeWordhost = writePrimFixed P.wordHost+{-# INLINE writeWordhost #-}++-- | Write a 'Word16' in native host order and host endianness.+writeWord16host :: Word16 -> Write+writeWord16host = writePrimFixed P.word16Host+{-# INLINE writeWord16host #-}++-- | Write a 'Word32' in native host order and host endianness.+writeWord32host :: Word32 -> Write+writeWord32host = writePrimFixed P.word32Host+{-# INLINE writeWord32host #-}++-- | Write a 'Word64' in native host order and host endianness.+writeWord64host :: Word64 -> Write+writeWord64host = writePrimFixed P.word64Host+{-# INLINE writeWord64host #-}++-- | Serialize a single byte.+fromWord8 :: Word8 -> Builder+fromWord8 = B.word8+{-# INLINE fromWord8 #-}++-- | Serialize a list of bytes.+fromWord8s :: [Word8] -> Builder+fromWord8s = P.primMapListFixed P.word8+{-# INLINE fromWord8s #-}++-- | Serialize a 'Word16' in big endian format.+fromWord16be :: Word16 -> Builder+fromWord16be = B.word16BE+{-# INLINE fromWord16be #-}++-- | Serialize a 'Word32' in big endian format.+fromWord32be :: Word32 -> Builder+fromWord32be = B.word32BE+{-# INLINE fromWord32be #-}++-- | Serialize a 'Word64' in big endian format.+fromWord64be :: Word64 -> Builder+fromWord64be = B.word64BE+{-# INLINE fromWord64be #-}++-- | Serialize a list of 'Word32's in big endian format.+fromWord32sbe :: [Word32] -> Builder+fromWord32sbe = P.primMapListFixed P.word32BE+{-# INLINE fromWord32sbe #-}++-- | Serialize a list of 'Word16's in big endian format.+fromWord16sbe :: [Word16] -> Builder+fromWord16sbe = P.primMapListFixed P.word16BE+{-# INLINE fromWord16sbe #-}++-- | Serialize a list of 'Word64's in big endian format.+fromWord64sbe :: [Word64] -> Builder+fromWord64sbe = P.primMapListFixed P.word64BE+{-# INLINE fromWord64sbe #-}++-- | Serialize a 'Word16' in little endian format.+fromWord16le :: Word16 -> Builder+fromWord16le = B.word16LE+{-# INLINE fromWord16le #-}++-- | Serialize a list of 'Word32's in little endian format.+fromWord32le :: Word32 -> Builder+fromWord32le = B.word32LE+{-# INLINE fromWord32le #-}++-- | Serialize a 'Word64' in little endian format.+fromWord64le :: Word64 -> Builder+fromWord64le = B.word64LE+{-# INLINE fromWord64le #-}++-- | Serialize a list of 'Word16's in little endian format.+fromWord16sle :: [Word16] -> Builder+fromWord16sle = P.primMapListFixed P.word16LE+{-# INLINE fromWord16sle #-}++-- | Serialize a list of 'Word32's in little endian format.+fromWord32sle :: [Word32] -> Builder+fromWord32sle = P.primMapListFixed P.word32LE+{-# INLINE fromWord32sle #-}++-- | Serialize a list of 'Word64's in little endian format.+fromWord64sle :: [Word64] -> Builder+fromWord64sle = P.primMapListFixed P.word64LE+{-# INLINE fromWord64sle #-}++-- | Serialize a single native machine 'Word'. The 'Word' is serialized in host+-- order, host endian form, for the machine you're on. On a 64 bit machine the+-- 'Word' is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this+-- way are not portable to different endian or word sized machines, without+-- conversion.+fromWordhost :: Word -> Builder+fromWordhost = B.wordHost+{-# INLINE fromWordhost #-}++-- | Write a 'Word16' in native host order and host endianness.+fromWord16host :: Word16 -> Builder+fromWord16host = B.word16Host+{-# INLINE fromWord16host #-}++-- | Write a 'Word32' in native host order and host endianness.+fromWord32host :: Word32 -> Builder+fromWord32host = B.word32Host+{-# INLINE fromWord32host #-}++-- | Write a 'Word64' in native host order and host endianness.+fromWord64host :: Word64 -> Builder+fromWord64host = B.word64Host+{-# INLINE fromWord64host #-}++-- | Serialize a list of 'Word's.+-- See 'fromWordhost' for usage considerations.+fromWordshost :: [Word] -> Builder+fromWordshost = P.primMapListFixed P.wordHost+{-# INLINE fromWordshost #-}++-- | Write a list of 'Word16's in native host order and host endianness.+fromWord16shost :: [Word16] -> Builder+fromWord16shost = P.primMapListFixed P.word16Host+{-# INLINE fromWord16shost #-}++-- | Write a list of 'Word32's in native host order and host endianness.+fromWord32shost :: [Word32] -> Builder+fromWord32shost = P.primMapListFixed P.word32Host+{-# INLINE fromWord32shost #-}++-- | Write a 'Word64' in native host order and host endianness.+fromWord64shost :: [Word64] -> Builder+fromWord64shost = P.primMapListFixed P.word64Host+{-# INLINE fromWord64shost #-}
+ Data/ByteString/Builder/HTTP/Chunked.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings #-}+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.HTTP+-- Copyright: (c) 2013 Simon Meier+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- Support for HTTP response encoding.+--+------------------------------------------------------------------------------++module Data.ByteString.Builder.HTTP.Chunked (+ -- * Chunked HTTP transfer encoding+ chunkedTransferEncoding+ , chunkedTransferTerminator+ ) where++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word (Word32(..))+#else+import Data.Word+#endif++import Foreign++import qualified Data.ByteString as S+import Data.ByteString.Char8 ()++import Blaze.ByteString.Builder.Internal.Write+import Data.ByteString.Builder+import Data.ByteString.Builder.Internal+import Blaze.ByteString.Builder.ByteString (copyByteString)++import qualified Blaze.ByteString.Builder.Char8 as Char8++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif+++{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)+#else+shiftr_w32 = shiftR+#endif+++-- | Write a CRLF sequence.+writeCRLF :: Write+writeCRLF = Char8.writeChar '\r' `mappend` Char8.writeChar '\n'+{-# INLINE writeCRLF #-}++-- | Execute a write+{-# INLINE execWrite #-}+execWrite :: Write -> Ptr Word8 -> IO ()+execWrite w op = do+ _ <- runPoke (getPoke w) op+ return ()+++------------------------------------------------------------------------------+-- Hex Encoding Infrastructure+------------------------------------------------------------------------------++pokeWord32HexN :: Int -> Word32 -> Ptr Word8 -> IO ()+pokeWord32HexN n0 w0 op0 =+ go w0 (op0 `plusPtr` (n0 - 1))+ where+ go !w !op+ | op < op0 = return ()+ | otherwise = do+ let nibble :: Word8+ nibble = fromIntegral w .&. 0xF+ hex | nibble < 10 = 48 + nibble+ | otherwise = 55 + nibble+ poke op hex+ go (w `shiftr_w32` 4) (op `plusPtr` (-1))+{-# INLINE pokeWord32HexN #-}++iterationsUntilZero :: Integral a => (a -> a) -> a -> Int+iterationsUntilZero f = go 0+ where+ go !count 0 = count+ go !count !x = go (count+1) (f x)+{-# INLINE iterationsUntilZero #-}++-- | Length of the hex-string required to encode the given 'Word32'.+word32HexLength :: Word32 -> Int+word32HexLength = max 1 . iterationsUntilZero (`shiftr_w32` 4)+{-# INLINE word32HexLength #-}++writeWord32Hex :: Word32 -> Write+writeWord32Hex w =+ boundedWrite (2 * sizeOf w) (pokeN len $ pokeWord32HexN len w)+ where+ len = word32HexLength w+{-# INLINE writeWord32Hex #-}+++------------------------------------------------------------------------------+-- Chunked transfer encoding+------------------------------------------------------------------------------++-- | Transform a builder such that it uses chunked HTTP transfer encoding.+chunkedTransferEncoding :: Builder -> Builder+chunkedTransferEncoding innerBuilder =+ builder transferEncodingStep+ where+ transferEncodingStep k =+ go (runBuilder innerBuilder)+ where+ go innerStep !(BufferRange op ope)+ -- FIXME: Assert that outRemaining < maxBound :: Word32+ | outRemaining < minimalBufferSize =+ return $ bufferFull minimalBufferSize op (go innerStep)+ | otherwise = do+ let !brInner@(BufferRange opInner _) = BufferRange+ (op `plusPtr` (chunkSizeLength + 2)) -- leave space for chunk header+ (ope `plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data++ -- wraps the chunk, if it is non-empty, and returns the+ -- signal constructed with the correct end-of-data pointer+ {-# INLINE wrapChunk #-}+ wrapChunk :: Ptr Word8 -> (Ptr Word8 -> IO (BuildSignal a))+ -> IO (BuildSignal a)+ wrapChunk !opInner' mkSignal+ | opInner' == opInner = mkSignal op+ | otherwise = do+ pokeWord32HexN chunkSizeLength+ (fromIntegral $ opInner' `minusPtr` opInner)+ op+ execWrite writeCRLF (opInner `plusPtr` (-2))+ execWrite writeCRLF opInner'+ mkSignal (opInner' `plusPtr` 2)++ -- prepare handlers+ doneH opInner' _ = wrapChunk opInner' $ \op' -> do+ let !br' = BufferRange op' ope+ k br'++ fullH opInner' minRequiredSize nextInnerStep =+ wrapChunk opInner' $ \op' ->+ return $! bufferFull+ (minRequiredSize + maxEncodingOverhead)+ op'+ (go nextInnerStep)++ insertChunkH opInner' bs nextInnerStep+ | S.null bs = -- flush+ wrapChunk opInner' $ \op' ->+ return $! insertChunk op' S.empty (go nextInnerStep)++ | otherwise = -- insert non-empty bytestring+ wrapChunk opInner' $ \op' -> do+ -- add header for inserted bytestring+ -- FIXME: assert(S.length bs < maxBound :: Word32)+ !op'' <- (`runPoke` op') $ getPoke $+ writeWord32Hex (fromIntegral $ S.length bs)+ `mappend` writeCRLF++ -- insert bytestring and write CRLF in next buildstep+ return $! insertChunk+ op'' bs+ (runBuilderWith (fromWrite writeCRLF) $ go nextInnerStep)++ -- execute inner builder with reduced boundaries+ fillWithBuildStep innerStep doneH fullH insertChunkH brInner+ where+ -- minimal size guaranteed for actual data no need to require more+ -- than 1 byte to guarantee progress the larger sizes will be+ -- hopefully provided by the driver or requested by the wrapped+ -- builders.+ minimalChunkSize = 1++ -- overhead computation+ maxBeforeBufferOverhead = sizeOf (undefined :: Int) + 2 -- max chunk size and CRLF after header+ maxAfterBufferOverhead = 2 + -- CRLF after data+ sizeOf (undefined :: Int) + 2 -- max bytestring size, CRLF after header++ maxEncodingOverhead = maxBeforeBufferOverhead + maxAfterBufferOverhead++ minimalBufferSize = minimalChunkSize + maxEncodingOverhead++ -- remaining and required space computation+ outRemaining :: Int+ outRemaining = ope `minusPtr` op+ chunkSizeLength = word32HexLength $ fromIntegral outRemaining+++-- | The zero-length chunk '0\r\n\r\n' signaling the termination of the data transfer.+chunkedTransferTerminator :: Builder+chunkedTransferTerminator = copyByteString "0\r\n\r\n"
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jasper Van der Jeugt nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bsb-http-chunked.cabal view
@@ -0,0 +1,74 @@+Name: bsb-http-chunked+Version: 0+Synopsis: Chunked HTTP transfer encoding for bytestring builders++Description: This library is a new home for the+ Blaze.ByteString.Builder.HTTP module from the blaze-builder+ package.++Author: Jasper Van der Jeugt, Simon Meier, Leon P Smith+Copyright: (c) 2010-2014 Simon Meier+ (c) 2010 Jasper Van der Jeugt+ (c) 2013-2015 Leon P Smith+Maintainer: Simon Jakobi <simon.jakobi@gmail.com>++License: BSD3+License-file: LICENSE++Homepage: http://github.com/sjakobi/bsb-http-chunked+Bug-Reports: http://github.com/sjakobi/bsb-http-chunked/issues+Stability: Provisional++Category: Data, Network+Build-type: Simple+Cabal-version: >= 1.8++Extra-source-files: tests/*.hs++Source-repository head+ Type: git+ Location: https://github.com/sjakobi/bsb-http-chunked.git++Library+ ghc-options: -Wall++ exposed-modules: Data.ByteString.Builder.HTTP.Chunked++ other-modules: Blaze.ByteString.Builder+ Blaze.ByteString.Builder.ByteString+ Blaze.ByteString.Builder.Char8+ Blaze.ByteString.Builder.Compat.Write+ Blaze.ByteString.Builder.Int+ Blaze.ByteString.Builder.Internal.Write+ Blaze.ByteString.Builder.Word++ build-depends: base >= 4.3 && < 4.12,+ deepseq,+ text >= 0.10 && < 1.3++ if impl(ghc < 7.8)+ build-depends: bytestring >= 0.9 && < 0.11,+ bytestring-builder+ else+ build-depends: bytestring >= 0.10.4 && < 0.11++test-suite test+ -- Turn off until the package is cleaned up+ buildable: False+ type: exitcode-stdio-1.0++ hs-source-dirs: tests+ main-is: Tests.hs++ ghc-options: -Wall -fno-warn-orphans++ build-depends: base+ , blaze-builder+ , bytestring+ , HUnit+ , QuickCheck+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2+ , text+ , utf8-string
+ tests/LlvmSegfault.hs view
@@ -0,0 +1,35 @@+-- Author: Simon Meier <iridcode@gmail.com>, 10/06/2010+--+-- Attempt to find a small test-case for the segfaults that happen when+-- compiling the benchmarks with LLVM and GHC-7.0.1+--+module LlvmSegfault where++import Data.Word+import Data.Monoid+import qualified Data.ByteString.Lazy as L++import Foreign++import Blaze.ByteString.Builder.Internal++++fromWord8 :: Word8 -> Builder+fromWord8 w =+ Builder step+ where+ step k pf pe+ | pf < pe = do+ poke pf w+ let pf' = pf `plusPtr` 1+ pf' `seq` k pf' pe+ | otherwise = return $ BufferFull 1 pf (step k)+++word8s :: Builder+word8s = map (fromWord8 . fromIntegral) $ [(1::Int)..1000]++main :: IO ()+main =+ print $ toLazyByteStringWith 10 10 (mconcat word8s) L.empty
+ tests/Tests.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+#if __GLASGOW_HASKELL__ >= 704+{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}+#endif+-- | Tests for the Blaze builder+--+module Main where++import Control.Applicative ((<$>))+import Data.Monoid (mempty, mappend, mconcat)++import qualified Data.Text as T+import qualified Data.ByteString.Lazy as LB+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.Framework.Providers.HUnit+import Test.QuickCheck+import Test.HUnit hiding (Test)+import Codec.Binary.UTF8.String (decode)++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8+import Blaze.ByteString.Builder.Html.Utf8++main :: IO ()+main = defaultMain $ return $ testGroup "Tests" tests++tests :: [Test]+tests =+ [ testProperty "left identity Monoid law" monoidLeftIdentity+ , testProperty "right identity Monoid law" monoidRightIdentity+ , testProperty "associativity Monoid law" monoidAssociativity+ , testProperty "mconcat Monoid law" monoidConcat+ , testProperty "string → builder → string" fromStringToString+ , testProperty "string and text" stringAndText+ , testProperty "lazy bytestring identity" identityLazyByteString+ , testProperty "flushing identity" identityFlushing+ , testProperty "writeToByteString" writeToByteStringProp+ , testCase "escaping case 1" escaping1+ , testCase "escaping case 2" escaping2+ , testCase "escaping case 3" escaping3+ ]++monoidLeftIdentity :: Builder -> Bool+monoidLeftIdentity b = mappend mempty b == b++monoidRightIdentity :: Builder -> Bool+monoidRightIdentity b = mappend b mempty == b++monoidAssociativity :: Builder -> Builder -> Builder -> Bool+monoidAssociativity x y z = mappend x (mappend y z) == mappend (mappend x y) z++monoidConcat :: [Builder] -> Bool+monoidConcat xs = mconcat xs == foldr mappend mempty xs++fromStringToString :: String -> Bool+fromStringToString string = string == convert string+ where+ convert = decode . LB.unpack . toLazyByteString . fromString++stringAndText :: String -> Bool+stringAndText string = fromString string == fromText (T.pack string)++identityLazyByteString :: LB.ByteString -> Bool+identityLazyByteString lbs = lbs == toLazyByteString (fromLazyByteString lbs)++identityFlushing :: String -> String -> Bool+identityFlushing s1 s2 =+ let b1 = fromString s1+ b2 = fromString s2+ in b1 `mappend` b2 == b1 `mappend` flush `mappend` b2++writeToByteStringProp :: Write -> Bool+writeToByteStringProp w = toByteString (fromWrite w) == writeToByteString w++escaping1 :: Assertion+escaping1 = fromString "<hello>" @?= fromHtmlEscapedString "<hello>"++escaping2 :: Assertion+escaping2 = fromString "f &&& g" @?= fromHtmlEscapedString "f &&& g"++escaping3 :: Assertion+escaping3 = fromString ""'" @?= fromHtmlEscapedString "\"'"++instance Show Builder where+ show = show . toLazyByteString++instance Show Write where+ show = show . fromWrite++instance Eq Builder where+ b1 == b2 =+ -- different and small buffer sizses for testing wrapping behaviour+ toLazyByteStringWith 1024 1024 256 b1 mempty ==+ toLazyByteStringWith 2001 511 256 b2 mempty++-- | Artificially scale up size to ensures that buffer wrapping behaviour is+-- also tested.+numRepetitions :: Int+numRepetitions = 250++instance Arbitrary Builder where+ arbitrary = (mconcat . replicate numRepetitions . fromString) <$> arbitrary++instance Arbitrary Write where+ arbitrary = mconcat . map singleWrite <$> arbitrary+ where+ singleWrite (Left bs) = writeByteString (mconcat (LB.toChunks bs))+ singleWrite (Right w) = writeWord8 w++instance Arbitrary LB.ByteString where+ arbitrary = (LB.concat . replicate numRepetitions . LB.pack) <$> arbitrary