blaze-builder 0.3.3.4 → 0.4.4.1
raw patch · 42 files changed
Files
- Blaze/ByteString/Builder.hs +189/−23
- Blaze/ByteString/Builder/ByteString.hs +62/−164
- Blaze/ByteString/Builder/Char/Utf8.hs +25/−77
- Blaze/ByteString/Builder/Char8.hs +23/−38
- Blaze/ByteString/Builder/Compat/Write.hs +30/−0
- Blaze/ByteString/Builder/HTTP.hs +91/−104
- Blaze/ByteString/Builder/Html/Utf8.hs +57/−32
- Blaze/ByteString/Builder/Html/Word.hs +78/−0
- Blaze/ByteString/Builder/Int.hs +108/−146
- Blaze/ByteString/Builder/Internal.hs +0/−446
- Blaze/ByteString/Builder/Internal/Buffer.hs +0/−223
- Blaze/ByteString/Builder/Internal/Types.hs +0/−144
- Blaze/ByteString/Builder/Internal/UncheckedShifts.hs +0/−78
- Blaze/ByteString/Builder/Internal/Write.hs +42/−29
- Blaze/ByteString/Builder/Word.hs +97/−221
- CHANGELOG.md +184/−0
- CHANGES +0/−127
- Makefile +7/−10
- README.markdown +16/−11
- TODO +0/−73
- benchmarks/BenchThroughput.hs +23/−24
- benchmarks/BenchmarkServer.hs +10/−10
- benchmarks/BlazeVsBinary.hs +3/−3
- benchmarks/BoundedWrite.hs +8/−9
- benchmarks/BuilderBufferRange.hs +25/−25
- benchmarks/ChunkedWrite.hs +25/−26
- benchmarks/Compression.hs +5/−5
- benchmarks/FastPut.hs +43/−44
- benchmarks/LazyByteString.hs +68/−68
- benchmarks/PlotTest.hs +20/−20
- benchmarks/StrictIO.hs +0/−3
- benchmarks/StringAndText.hs +11/−10
- benchmarks/Throughput/BinaryBuilder.hs +1/−1
- benchmarks/Throughput/BlazeBuilder.hs +2/−2
- benchmarks/Throughput/BlazeBuilderDeclarative.hs +1/−2
- benchmarks/Throughput/BlazePut.hs +51/−51
- benchmarks/Throughput/BlazePutMonad.hs +2/−2
- benchmarks/Throughput/Utils.hs +1/−2
- benchmarks/UnboxedAppend.hs +12/−12
- benchmarks/Utf8IO.hs +7/−8
- blaze-builder.cabal +76/−41
- tests/Tests.hs +8/−6
Blaze/ByteString/Builder.hs view
@@ -1,12 +1,13 @@------------------------------------------------------------------------------+{-# LANGUAGE CPP, BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder--- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- "Blaze.ByteString.Builder" is the main module, which you should import as a user -- of the @blaze-builder@ library.@@ -54,42 +55,207 @@ -- 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- Builder+ B.Builder -- * Creating builders , module Blaze.ByteString.Builder.Int , module Blaze.ByteString.Builder.Word , module Blaze.ByteString.Builder.ByteString- , flush+ , B.flush -- * Executing builders- , toLazyByteString+ , B.toLazyByteString , toLazyByteStringWith , toByteString , toByteStringIO , toByteStringIOWith -- * 'Write's- , Write- , fromWrite- , fromWriteSingleton- , fromWriteList+ , W.Write+ , W.fromWrite+ , W.fromWriteSingleton+ , W.fromWriteList , writeToByteString -- ** Writing 'Storable's- , writeStorable- , fromStorable- , fromStorables+ , W.writeStorable+ , W.fromStorable+ , W.fromStorables ) where -import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Int-import Blaze.ByteString.Builder.Word-import Blaze.ByteString.Builder.ByteString+import Control.Monad(unless) +import Foreign+import qualified Foreign.ForeignPtr.Unsafe as Unsafe++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++import System.IO.Unsafe (unsafeDupablePerformIO)++withBS :: S.ByteString -> (ForeignPtr Word8 -> Int -> Int -> a) -> a+#if MIN_VERSION_bytestring(0,11,0)+withBS (S.BS fptr len) f = f fptr 0 len+#else+withBS (S.PS fptr offset len) f = f fptr offset len+#endif++mkBS :: ForeignPtr Word8 -> Int -> S.ByteString+#if MIN_VERSION_bytestring(0,11,0)+mkBS fptr len = S.BS fptr len+#else+mkBS fptr len = S.PS fptr 0 len+#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 bs lbs') !pf = withBS bs $ \fpbuf o l -> 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 $! mkBS fp bytes+ B.More req writer' -> do+ io $! mkBS fp bytes+ let !size' = max bufSize req+ S.mallocByteString size' >>= getBuffer writer' size'+ B.Chunk bs' writer' -> do+ if bytes > 0+ then do+ io $! mkBS fp 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
@@ -1,21 +1,12 @@-{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-+------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.ByteString--- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.ByteString+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable ----- 'Write's and 'Builder's for strict and lazy bytestrings.+-- '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.@@ -23,6 +14,8 @@ -- > import qualified Data.ByteString as S -- > import qualified Data.ByteString.Lazy as L --+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.ByteString ( -- * Strict bytestrings@@ -40,36 +33,17 @@ ) where -import Blaze.ByteString.Builder.Internal hiding (insertByteString)-import qualified Blaze.ByteString.Builder.Internal as I (insertByteString) -#ifdef HAS_FOREIGN_UNSAFE_MODULE-import Foreign (withForeignPtr, touchForeignPtr, copyBytes, plusPtr, minusPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#else-import Foreign (unsafeForeignPtrToPtr, withForeignPtr, touchForeignPtr, copyBytes, plusPtr, minusPtr)-#endif--import Data.Monoid--import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L--#ifdef BYTESTRING_IN_BASE-import qualified Data.ByteString.Base as S-import qualified Data.ByteString.Lazy.Base as L -- FIXME: check if this is the right module-#else+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.Internal as L-#endif+import qualified Data.ByteString.Lazy as L ---------------------------------------------------------------------------------- Strict ByteStrings-------------------------------------------------------------------------------- -- | Write a strict 'S.ByteString' to a buffer.--- writeByteString :: S.ByteString -> Write writeByteString bs = exactWrite l io where@@ -77,154 +51,78 @@ io pf = withForeignPtr fptr $ \p -> copyBytes pf (p `plusPtr` o) l {-# INLINE writeByteString #-} --- | Smart serialization of a strict bytestring.------ @'fromByteString' = 'fromByteStringWith' 'defaultMaximalCopySize'@------ Use this function to serialize strict bytestrings. It guarantees an--- average chunk size of 4kb, which has been shown to be a reasonable size in--- benchmarks. Note that the check whether to copy or to insert is (almost)--- free as the builder performance is mostly memory-bound.------ If you statically know that copying or inserting the strict bytestring is--- always the best choice, then you can use the 'copyByteString' or--- 'insertByteString' functions.----fromByteString :: S.ByteString -> Builder-fromByteString = fromByteStringWith defaultMaximalCopySize+-- | 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 #-} --- | @fromByteStringWith maximalCopySize bs@ serializes the strict bytestring--- @bs@ according to the following rules.------ [@S.length bs <= maximalCopySize@:] @bs@ is copied to the output buffer.------ [@S.length bs > maximalCopySize@:] @bs@ the output buffer is flushed and--- @bs@ is inserted directly as separate chunk in the output stream.+-- | Construct a 'B.Builder' that copies the strict 'S.ByteString's, if it is+-- smaller than the threshold, and inserts it directly otherwise. ----- These rules guarantee that average chunk size in the output stream is at--- least half the @maximalCopySize@.+-- 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.- -> Builder -- ^ Resulting 'Builder'.-fromByteStringWith maxCopySize =- \bs -> fromBuildStepCont $ step bs- where- step !bs !k br@(BufRange !op _)- | maxCopySize < S.length bs = return $ I.insertByteString op bs k- | otherwise = copyByteStringStep bs k br+ -> B.Builder -- ^ Resulting 'B.Builder'.+fromByteStringWith = B.byteStringThreshold {-# INLINE fromByteStringWith #-} --- | @copyByteString bs@ serialize the strict bytestring @bs@ by copying it to--- the output buffer.+-- | Construct a 'B.Builder' that copies the strict 'S.ByteString'. ----- Use this function to serialize strict bytestrings that are statically known--- to be smallish (@<= 4kb@).+-- 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 -> Builder-copyByteString = \bs -> fromBuildStepCont $ copyByteStringStep bs+copyByteString :: S.ByteString -> B.Builder+copyByteString = B.byteStringCopy {-# INLINE copyByteString #-} -copyByteStringStep :: S.ByteString- -> (BufRange -> IO (BuildSignal a))- -> (BufRange -> IO (BuildSignal a))-copyByteStringStep (S.PS ifp ioff isize) !k =- goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff)- where- !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)- goBS !ip !(BufRange op ope)- | inpRemaining <= outRemaining = do- copyBytes op ip inpRemaining- touchForeignPtr ifp -- input consumed: OK to release from here- let !br' = BufRange (op `plusPtr` inpRemaining) ope- k br'- | otherwise = do- copyBytes op ip outRemaining- let !ip' = ip `plusPtr` outRemaining- return $ bufferFull 1 ope (goBS ip')- where- outRemaining = ope `minusPtr` op- inpRemaining = ipe `minusPtr` ip-{-# INLINE copyByteStringStep #-}---- | @insertByteString bs@ serializes the strict bytestring @bs@ by inserting--- it directly as a chunk of the output stream.+-- | Construct a 'B.Builder' that always inserts the strict 'S.ByteString'+-- directly as a chunk. ----- Note that this implies flushing the output buffer; even if it contains just--- a single byte. Hence, you should use this operation only for large (@> 8kb@)--- bytestrings, as otherwise the resulting output stream may be too fragmented--- to be processed efficiently.+-- 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 -> Builder-insertByteString =- \bs -> fromBuildStepCont $ step bs- where- step !bs !k !(BufRange op _) = return $ I.insertByteString op bs k+insertByteString :: S.ByteString -> B.Builder+insertByteString = B.byteStringInsert {-# INLINE insertByteString #-} ---- Lazy bytestrings----------------------------------------------------------------------------------- | /O(n)/. Smart serialization of a lazy bytestring.------ @'fromLazyByteString' = 'fromLazyByteStringWith' 'defaultMaximalCopySize'@------ Use this function to serialize lazy bytestrings. It guarantees an average--- chunk size of 4kb, which has been shown to be a reasonable size in--- benchmarks. Note that the check whether to copy or to insert is (almost)--- free as the builder performance is mostly memory-bound.------ If you statically know that copying or inserting /all/ chunks of the lazy--- bytestring is always the best choice, then you can use the--- 'copyLazyByteString' or 'insertLazyByteString' functions.+-- | 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 -> Builder-fromLazyByteString = fromLazyByteStringWith defaultMaximalCopySize+fromLazyByteString :: L.ByteString -> B.Builder+fromLazyByteString = B.lazyByteString {-# INLINE fromLazyByteString #-} --- | /O(n)/. Serialize a lazy bytestring chunk-wise according to the same rules--- as in 'fromByteStringWith'.------ Semantically, it holds that------ > fromLazyByteStringWith maxCopySize--- > = mconcat . map (fromByteStringWith maxCopySize) . L.toChunks------ However, the left-hand-side is much more efficient, as it moves the--- end-of-buffer pointer out of the inner loop and provides the compiler with--- more strictness information.+-- | Construct a 'B.Builder' that uses the thresholding strategy of 'fromByteStringWith'+-- for each chunk of the lazy 'L.ByteString'. ---fromLazyByteStringWith :: Int -- ^ Maximal number of bytes to copy.- -> L.ByteString -- ^ Lazy 'L.ByteString' to serialize.- -> Builder -- ^ Resulting 'Builder'.-fromLazyByteStringWith maxCopySize =- L.foldrChunks (\bs b -> fromByteStringWith maxCopySize bs `mappend` b) mempty+fromLazyByteStringWith :: Int -> L.ByteString -> B.Builder+fromLazyByteStringWith = B.lazyByteStringThreshold {-# INLINE fromLazyByteStringWith #-} ---- | /O(n)/. Serialize a lazy bytestring by copying /all/ chunks sequentially--- to the output buffer.------ See 'copyByteString' for usage considerations.+-- | Construct a 'B.Builder' that copies the lazy 'L.ByteString'. ---copyLazyByteString :: L.ByteString -> Builder-copyLazyByteString =- L.foldrChunks (\bs b -> copyByteString bs `mappend` b) mempty+copyLazyByteString :: L.ByteString -> B.Builder+copyLazyByteString = B.lazyByteStringCopy {-# INLINE copyLazyByteString #-} --- | /O(n)/. Serialize a lazy bytestring by inserting /all/ its chunks directly--- into the output stream.------ See 'insertByteString' for usage considerations.------ For library developers, see the 'ModifyChunks' build signal, if you--- need an /O(1)/ lazy bytestring insert based on difference lists.+-- | Construct a 'B.Builder' that inserts all chunks of the lazy 'L.ByteString'+-- directly. ---insertLazyByteString :: L.ByteString -> Builder-insertLazyByteString =- L.foldrChunks (\bs b -> insertByteString bs `mappend` b) mempty+insertLazyByteString :: L.ByteString -> B.Builder+insertLazyByteString = B.lazyByteStringInsert {-# INLINE insertLazyByteString #-}-
Blaze/ByteString/Builder/Char/Utf8.hs view
@@ -1,18 +1,16 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- ignore warning from 'import Data.Text.Encoding'-+------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.Char.Utf8--- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.Char.Utf8+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- 'Write's and 'Builder's for serializing Unicode characters using the UTF-8 -- encoding. --+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.Char.Utf8 ( -- * Writing UTF-8 encoded characters to a buffer@@ -26,98 +24,48 @@ , fromLazyText ) where -import Foreign-import Data.Char (ord)--import qualified Data.Text as TS-import qualified Data.Text.Encoding as TS -- imported for documentation links-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TS -- imported for documentation links--import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Compat.Write (Write, writePrimBounded)+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.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE -- | Write a UTF-8 encoded Unicode character to a buffer. ---{-# INLINE writeChar #-} writeChar :: Char -> Write-writeChar c = boundedWrite 4 (encodeCharUtf8 f1 f2 f3 f4 c)- where- 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.----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-{-# INLINE encodeCharUtf8 #-}+writeChar = writePrimBounded P.charUtf8+{-# INLINE writeChar #-} -- | /O(1)/. Serialize a Unicode character using the UTF-8 encoding. -- fromChar :: Char -> Builder-fromChar = fromWriteSingleton writeChar+fromChar = B.charUtf8+{-# INLINE fromChar #-} -- | /O(n)/. Serialize a Unicode 'String' using the UTF-8 encoding. -- fromString :: String -> Builder-fromString = fromWriteList writeChar--- Performance note: ^^^------ fromWrite2List made things slightly worse for the blaze-html benchmarks--- despite being better when serializing only a list. Probably, the cache is--- already occupied enough with dealing with the data from Html rendering.----+fromString = B.stringUtf8+{-# INLINE fromString #-} -- | /O(n)/. Serialize a value by 'Show'ing it and UTF-8 encoding the resulting -- 'String'. -- fromShow :: Show a => a -> Builder fromShow = fromString . show+{-# INLINE fromShow #-} -- | /O(n)/. Serialize a strict Unicode 'TS.Text' value using the UTF-8 encoding. -- fromText :: TS.Text -> Builder-fromText = fromString . TS.unpack+fromText = TE.encodeUtf8Builder {-# INLINE fromText #-} - -- | /O(n)/. Serialize a lazy Unicode 'TL.Text' value using the UTF-8 encoding. -- fromLazyText :: TL.Text -> Builder-fromLazyText = fromString . TL.unpack+fromLazyText = TLE.encodeUtf8Builder {-# INLINE fromLazyText #-}
Blaze/ByteString/Builder/Char8.hs view
@@ -1,20 +1,10 @@--- ignore warning from 'import Data.Text.Encoding'-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.Char8--- Copyright : (c) 2010 Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.Char8+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- //Note:// This package is intended for low-level use like implementing -- protocols. If you need to //serialize// Unicode characters use one of the@@ -25,6 +15,8 @@ -- 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@@ -38,47 +30,40 @@ , fromLazyText ) where -import Foreign-import Data.Char (ord)--import qualified Data.Text as TS-import qualified Data.Text.Encoding as TS -- imported for documentation links-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TS -- imported for documentation links--import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.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.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.----{-# INLINE writeChar #-} writeChar :: Char -> Write-writeChar = writeWord8 . fromIntegral . ord+writeChar = writePrimFixed P.char8+{-# INLINE writeChar #-} -- | /O(1)/. Serialize the lower 8-bits of a character.--- fromChar :: Char -> Builder-fromChar = fromWriteSingleton writeChar+fromChar = B.char8+{-# INLINE fromChar #-} -- | /O(n)/. Serialize the lower 8-bits of all characters of a string--- fromString :: String -> Builder-fromString = fromWriteList writeChar+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.----{-# INLINE fromText #-} fromText :: TS.Text -> Builder fromText = fromString . TS.unpack+{-# INLINE fromText #-} -- | /O(n)/. Serialize the lower 8-bits of all characters in the lazy text.----{-# INLINE fromLazyText #-} 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: https://github.com/blaze-builder+-- Stability: stable+--+-- 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/HTTP.hs view
@@ -1,37 +1,60 @@ {-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- | Support for HTTP response encoding.+------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.HTTP+-- Copyright: (c) 2013 Simon Meier+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable ----- TODO: Improve documentation.+-- Support for HTTP response encoding.+--+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.HTTP ( -- * Chunked HTTP transfer encoding chunkedTransferEncoding , chunkedTransferTerminator ) where -import Data.Monoid-import qualified Data.ByteString as S-import Data.ByteString.Char8 ()+#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 Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Internal.Types-import Blaze.ByteString.Builder.Internal.UncheckedShifts+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 --- only required by test-code--- import qualified Data.ByteString.Lazy as L--- import qualified Blaze.ByteString.Builder.ByteString as B--- import Data.ByteString.Char8 ()+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32 +#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#if MIN_VERSION_base(4,16,0)+-- base >= 4.16 proxy for GHC >= 9.2 which fixes ghc-prim >= 0.8+shiftr_w32 (W32# w) (I# i) = W32# (wordToWord32# ((word32ToWord# w) `uncheckedShiftRL#` i))+#else+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)+#endif+#else+shiftr_w32 = shiftR+#endif + -- | Write a CRLF sequence. writeCRLF :: Write writeCRLF = Char8.writeChar '\r' `mappend` Char8.writeChar '\n'@@ -49,28 +72,6 @@ -- Hex Encoding Infrastructure ------------------------------------------------------------------------------ -{--pokeWord16Hex :: Word16 -> Ptr Word8 -> IO ()-pokeWord16Hex x op = do- pokeNibble 0 12- pokeNibble 1 8- pokeNibble 2 4- pokeNibble 3 0- where- pokeNibble off s- | n < 10 = pokeWord8 off (fromIntegral $ 48 + n)- | otherwise = pokeWord8 off (fromIntegral $ 55 + n)- where- n = shiftr_w16 x s .&. 0xF-- pokeWord8 :: Int -> Word8 -> IO ()- pokeWord8 off = poke (op `plusPtr` off)--writeWord16Hex :: Word16 -> Write-writeWord16Hex = exactWrite 4 . pokeWord16Hex---}- pokeWord32HexN :: Int -> Word32 -> Ptr Word8 -> IO () pokeWord32HexN n0 w0 op0 = go w0 (op0 `plusPtr` (n0 - 1))@@ -98,52 +99,39 @@ word32HexLength = max 1 . iterationsUntilZero (`shiftr_w32` 4) {-# INLINE word32HexLength #-} +-- | Maximum length of a hex string encoding any 'Word32'.+-- Same as @word32HexLength maxBound@.+maxWord32HexLength :: Int+maxWord32HexLength = 8+ writeWord32Hex :: Word32 -> Write writeWord32Hex w =- boundedWrite (2 * sizeOf w) (pokeN len $ pokeWord32HexN len w)+ boundedWrite maxWord32HexLength (pokeN len $ pokeWord32HexN len w) where len = word32HexLength w {-# INLINE writeWord32Hex #-} -{--test = flip (toLazyByteStringWith 32 32 32) L.empty- $ chunkedTransferEncoding- $ mconcat $ map oneLine [0..16] ++- [B.insertByteString "hello"] ++- map oneLine [0,1] ++- [B.insertByteString ""] ++- map oneLine [0..16] - where- oneLine x = fromWriteSingleton writeWord32Hex x `mappend` Char8.fromChar ' '--test = print $ toLazyByteString- $ chunkedTransferEncoding body `mappend` chunkedTransferTerminator--body = copyByteString "maa" `mappend` copyByteString "foo" `mappend` copyByteString "bar"--}- ------------------------------------------------------------------------------ -- Chunked transfer encoding ------------------------------------------------------------------------------ -- | Transform a builder such that it uses chunked HTTP transfer encoding. chunkedTransferEncoding :: Builder -> Builder-chunkedTransferEncoding (Builder b) =- fromBuildStepCont transferEncodingStep+chunkedTransferEncoding innerBuilder =+ builder transferEncodingStep where- finalStep !(BufRange op _) = return $ Done op ()-- transferEncodingStep k = go (b (buildStep finalStep))+ transferEncodingStep k =+ go (runBuilder innerBuilder) where- go innerStep !(BufRange op ope)+ go innerStep !(BufferRange op ope) -- FIXME: Assert that outRemaining < maxBound :: Word32 | outRemaining < minimalBufferSize = return $ bufferFull minimalBufferSize op (go innerStep) | otherwise = do- let !brInner@(BufRange opInner _) = BufRange- (op `plusPtr` (chunkSizeLength + 2)) -- leave space for chunk header- (ope `plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data+ let !brInner@(BufferRange opInner _) = BufferRange+ (op `plusPtr` (chunkSizeLength + crlfLength)) -- 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@@ -156,45 +144,42 @@ pokeWord32HexN chunkSizeLength (fromIntegral $ opInner' `minusPtr` opInner) op- execWrite writeCRLF (opInner `plusPtr` (-2))+ execWrite writeCRLF (opInner `plusPtr` (-crlfLength)) execWrite writeCRLF opInner'- mkSignal (opInner' `plusPtr` 2)-- -- execute inner builder with reduced boundaries- signal <- runBuildStep innerStep brInner- case signal of- Done opInner' _ ->- wrapChunk opInner' $ \op' -> do- let !br' = BufRange op' ope- k br'+ mkSignal (opInner' `plusPtr` crlfLength) - BufferFull minRequiredSize opInner' nextInnerStep ->- wrapChunk opInner' $ \op' ->- return $! bufferFull- (minRequiredSize + maxEncodingOverhead)- op'- (go nextInnerStep)+ -- prepare handlers+ doneH opInner' _ = wrapChunk opInner' $ \op' -> do+ let !br' = BufferRange op' ope+ k br' - InsertByteString opInner' bs nextInnerStep- | S.null bs -> -- flush+ fullH opInner' minRequiredSize nextInnerStep = wrapChunk opInner' $ \op' ->- return $! insertByteString- op' S.empty+ return $! bufferFull+ (minRequiredSize + maxEncodingOverhead)+ op' (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 $! InsertByteString- op'' bs- (unBuilder (fromWrite writeCRLF) $- buildStep $ 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@@ -202,10 +187,14 @@ -- 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+ -- overhead computation which is when (re)sizing the output buffer.+ -- We make sure we have enough space+ -- - at the beginning of the chunk for the chunk length followed by CRLF+ -- - at the end of the chunk for the terminating CRLF and+ -- the chunk header (see above) of the next chunk.+ crlfLength = 2+ maxBeforeBufferOverhead = maxWord32HexLength + crlfLength+ maxAfterBufferOverhead = crlfLength + maxWord32HexLength + crlfLength maxEncodingOverhead = maxBeforeBufferOverhead + maxAfterBufferOverhead @@ -220,5 +209,3 @@ -- | 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"--
Blaze/ByteString/Builder/Html/Utf8.hs view
@@ -1,12 +1,14 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}++------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.Html.Utf8--- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.Html.Utf8+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- 'Write's and 'Builder's for serializing HTML escaped and UTF-8 encoded -- characters.@@ -15,6 +17,9 @@ -- templating libraries. If the 'Builder' from 'blaze-builder' replaces the -- 'Data.Binary.Builder' implementation, this module will most likely keep its -- place, as it provides a set of very specialized functions.+--+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.Html.Utf8 ( module Blaze.ByteString.Builder.Char.Utf8@@ -33,54 +38,74 @@ import Data.ByteString.Char8 () -- for the 'IsString' instance of bytesrings import qualified Data.Text as TS+import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE -import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimBounded )+import qualified Data.ByteString.Builder as B+import Data.ByteString.Builder.Prim ((>*<), (>$<), condB)+import qualified Data.ByteString.Builder.Prim as P+ import Blaze.ByteString.Builder.Char.Utf8+import Blaze.ByteString.Builder.Html.Word -- | Write a HTML escaped and UTF-8 encoded Unicode character to a bufffer. -- writeHtmlEscapedChar :: Char -> Write-writeHtmlEscapedChar c0 =- boundedWrite 6 (io c0)- -- WARNING: Don't forget to change the bound if you change the bytestrings.- where- io '<' = getPoke $ writeByteString "<"- io '>' = getPoke $ writeByteString ">"- io '&' = getPoke $ writeByteString "&"- io '"' = getPoke $ writeByteString """- io '\'' = getPoke $ writeByteString "'"- io c = getPoke $ writeChar c+writeHtmlEscapedChar = writePrimBounded charUtf8HtmlEscaped {-# INLINE writeHtmlEscapedChar #-} -- | /O(1)./ Serialize a HTML escaped Unicode character using the UTF-8 -- encoding.----fromHtmlEscapedChar :: Char -> Builder-fromHtmlEscapedChar = fromWriteSingleton writeHtmlEscapedChar+fromHtmlEscapedChar :: Char -> B.Builder+fromHtmlEscapedChar = P.primBounded charUtf8HtmlEscaped+{-# INLINE fromHtmlEscapedChar #-} +{-# INLINE charUtf8HtmlEscaped #-}+charUtf8HtmlEscaped :: P.BoundedPrim Char+charUtf8HtmlEscaped =+ condB (> '>' ) (condB (== '\DEL') P.emptyB P.charUtf8) $+ condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $ -- <+ condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $ -- >+ condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $ -- &+ condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $ -- &#quot;+ condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $ -- '+ condB (\c -> c >= ' ' || c == '\t' || c == '\n' || c == '\r')+ (P.liftFixedToBounded P.char7) $+ P.emptyB+ where+ {-# INLINE fixed4 #-}+ fixed4 x = P.liftFixedToBounded $ const x >$<+ P.char7 >*< P.char7 >*< P.char7 >*< P.char7++ {-# INLINE fixed5 #-}+ fixed5 x = P.liftFixedToBounded $ const x >$<+ P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7++ {-# INLINE fixed6 #-}+ fixed6 x = P.liftFixedToBounded $ const x >$<+ P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7+ -- | /O(n)/. Serialize a HTML escaped Unicode 'String' using the UTF-8 -- encoding. ---fromHtmlEscapedString :: String -> Builder-fromHtmlEscapedString = fromWriteList writeHtmlEscapedChar+fromHtmlEscapedString :: String -> B.Builder+fromHtmlEscapedString = P.primMapListBounded charUtf8HtmlEscaped -- | /O(n)/. Serialize a value by 'Show'ing it and then, HTML escaping and -- UTF-8 encoding the resulting 'String'. ---fromHtmlEscapedShow :: Show a => a -> Builder+fromHtmlEscapedShow :: Show a => a -> B.Builder fromHtmlEscapedShow = fromHtmlEscapedString . show - -- | /O(n)/. Serialize a HTML escaped strict Unicode 'TS.Text' value using the -- UTF-8 encoding. ---fromHtmlEscapedText :: TS.Text -> Builder-fromHtmlEscapedText = fromHtmlEscapedString . TS.unpack+fromHtmlEscapedText :: TS.Text -> B.Builder+fromHtmlEscapedText = TE.encodeUtf8BuilderEscaped wordHtmlEscaped -- | /O(n)/. Serialize a HTML escaped Unicode 'TL.Text' using the UTF-8 encoding. ---fromHtmlEscapedLazyText :: TL.Text -> Builder-fromHtmlEscapedLazyText = fromHtmlEscapedString . TL.unpack-+fromHtmlEscapedLazyText :: TL.Text -> B.Builder+fromHtmlEscapedLazyText = TLE.encodeUtf8BuilderEscaped wordHtmlEscaped
+ Blaze/ByteString/Builder/Html/Word.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}++------------------------------------------------------------------------------+-- |+-- Module: Blaze.ByteString.Builder.Html.Word+-- Copyright: (c) 2016 Dylan Simon+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable+--+-- 'W.Write's and 'B.Builder's for serializing HTML escaped 'Word8' characters+-- and 'BS.ByteString's that have already been appropriately encoded into HTML by+-- escaping basic ASCII character references but leaving other bytes untouched.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Html.Word+ ( wordHtmlEscaped+ -- * Writing HTML escaped bytes to a buffer+ , writeHtmlEscapedWord+ -- * Creating Builders from HTML escaped bytes+ , fromHtmlEscapedWord+ , fromHtmlEscapedWordList+ , fromHtmlEscapedByteString+ , fromHtmlEscapedLazyByteString+ ) where++import qualified Blaze.ByteString.Builder.Compat.Write as W+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Prim as P+import Data.ByteString.Internal (c2w)+import qualified Data.ByteString.Lazy as BSL+import Data.Word (Word8)++{-# INLINE wordHtmlEscaped #-}+wordHtmlEscaped :: P.BoundedPrim Word8+wordHtmlEscaped =+ P.condB (> c2w '>' ) (P.condB (== c2w '\DEL') P.emptyB $ P.liftFixedToBounded P.word8) $+ P.condB (== c2w '<' ) (fixed4 ('&',('l',('t',';')))) $ -- <+ P.condB (== c2w '>' ) (fixed4 ('&',('g',('t',';')))) $ -- >+ P.condB (== c2w '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $ -- &+ P.condB (== c2w '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $ -- "+ P.condB (== c2w '\'') (fixed5 ('&',('#',('3',('9',';'))))) $ -- '+ P.condB (\c -> c >= c2w ' ' || c == c2w '\t' || c == c2w '\n' || c == c2w '\r')+ (P.liftFixedToBounded P.word8) P.emptyB+ where+ {-# INLINE fixed4 #-}+ fixed4 x = P.liftFixedToBounded $ const x P.>$<+ P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8+ {-# INLINE fixed5 #-}+ fixed5 x = P.liftFixedToBounded $ const x P.>$<+ P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8+ {-# INLINE fixed6 #-}+ fixed6 x = P.liftFixedToBounded $ const x P.>$<+ P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8++-- | Write a HTML escaped byte to a bufffer.+writeHtmlEscapedWord :: Word8 -> W.Write+writeHtmlEscapedWord = W.writePrimBounded wordHtmlEscaped++-- | /O(1)./ Serialize a HTML escaped byte.+fromHtmlEscapedWord :: Word8 -> B.Builder+fromHtmlEscapedWord = P.primBounded wordHtmlEscaped++-- | /O(n)/. Serialize a HTML escaped list of bytes.+fromHtmlEscapedWordList :: [Word8] -> B.Builder+fromHtmlEscapedWordList = P.primMapListBounded wordHtmlEscaped++-- | /O(n)/. Serialize a HTML escaped 'BS.ByteString'.+fromHtmlEscapedByteString :: BS.ByteString -> B.Builder+fromHtmlEscapedByteString = P.primMapByteStringBounded wordHtmlEscaped++-- | /O(n)/. Serialize a HTML escaped lazy 'BSL.ByteString'.+fromHtmlEscapedLazyByteString :: BSL.ByteString -> B.Builder+fromHtmlEscapedLazyByteString = P.primMapLazyByteStringBounded wordHtmlEscaped
Blaze/ByteString/Builder/Int.hs view
@@ -1,24 +1,18 @@-{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.Int--- Copyright : (c) 2010 Simon Meier------ License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.Int+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- '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@@ -79,60 +73,48 @@ ) where -import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Word--import Foreign----------------------------------------------------------------------------------- Int writes--------------------- we rely on 'fromIntegral' to do a loss-less conversion to the corresponding--- 'Word' type-----------------------------------------------------------------------------------+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 = writeWord8 . fromIntegral+writeInt8 :: Int8 -> Write+writeInt8 = writePrimFixed P.int8 {-# INLINE writeInt8 #-} -- | Write an 'Int16' in big endian format.-writeInt16be :: Int16 -> Write-writeInt16be = writeWord16be . fromIntegral+writeInt16be :: Int16 -> Write+writeInt16be = writePrimFixed P.int16BE {-# INLINE writeInt16be #-} --- | Write an 'Int16' in little endian format.-writeInt16le :: Int16 -> Write-writeInt16le = writeWord16le . fromIntegral-{-# INLINE writeInt16le #-}- -- | Write an 'Int32' in big endian format.-writeInt32be :: Int32 -> Write-writeInt32be = writeWord32be . fromIntegral+writeInt32be :: Int32 -> Write+writeInt32be = writePrimFixed P.int32BE {-# INLINE writeInt32be #-} --- | Write an 'Int32' in little endian format.-writeInt32le :: Int32 -> Write-writeInt32le = writeWord32le . fromIntegral-{-# INLINE writeInt32le #-}- -- | Write an 'Int64' in big endian format.-writeInt64be :: Int64 -> Write-writeInt64be = writeWord64be . fromIntegral+writeInt64be :: Int64 -> Write+writeInt64be = writePrimFixed P.int64BE {-# INLINE writeInt64be #-} --- | Write an 'Int64' in little endian format.-writeInt64le :: Int64 -> Write-writeInt64le = writeWord64le . fromIntegral-{-# INLINE writeInt64le #-}+-- | 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 #-} ---------------------------------------------------------------------------- Unaligned, integer size ops+-- | 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'@@ -140,114 +122,94 @@ -- are not portable to different endian or integer sized machines, without -- conversion. ---writeInthost :: Int -> Write-writeInthost = writeStorable+writeInthost :: Int -> Write+writeInthost = writePrimFixed P.intHost {-# INLINE writeInthost #-} -- | Write an 'Int16' in native host order and host endianness. writeInt16host :: Int16 -> Write-writeInt16host = writeStorable+writeInt16host = writePrimFixed P.int16Host {-# INLINE writeInt16host #-} -- | Write an 'Int32' in native host order and host endianness. writeInt32host :: Int32 -> Write-writeInt32host = writeStorable+writeInt32host = writePrimFixed P.int32Host {-# INLINE writeInt32host #-} -- | Write an 'Int64' in native host order and host endianness. writeInt64host :: Int64 -> Write-writeInt64host = writeStorable+writeInt64host = writePrimFixed P.int64Host {-# INLINE writeInt64host #-} ----------------------------------------------------------------------------------- Builders corresponding to the integer writes----------------------------------------------------------------------------------- Single bytes-------------------------------------------------------------------------------- -- | Serialize a single byte.----fromInt8 :: Int8 -> Builder-fromInt8 = fromWriteSingleton writeInt8+fromInt8 :: Int8 -> Builder+fromInt8 = B.int8+{-# INLINE fromInt8 #-} -- | Serialize a list of bytes.----fromInt8s :: [Int8] -> Builder-fromInt8s = fromWriteList writeInt8----- Int16-------------------------------------------------------------------------------+fromInt8s :: [Int8] -> Builder+fromInt8s = P.primMapListFixed P.int8+{-# INLINE fromInt8s #-} -- | Serialize an 'Int16' in big endian format.-fromInt16be :: Int16 -> Builder-fromInt16be = fromWriteSingleton writeInt16be+fromInt16be :: Int16 -> Builder+fromInt16be = B.int16BE {-# INLINE fromInt16be #-} --- | Serialize a list of 'Int16's in big endian format.-fromInt16sbe :: [Int16] -> Builder-fromInt16sbe = fromWriteList writeInt16be-{-# INLINE fromInt16sbe #-}---- | Serialize an 'Int16' in little endian format.-fromInt16le :: Int16 -> Builder-fromInt16le = fromWriteSingleton writeInt16le-{-# INLINE fromInt16le #-}---- | Serialize a list of 'Int16's in little endian format.-fromInt16sle :: [Int16] -> Builder-fromInt16sle = fromWriteList writeInt16le-{-# INLINE fromInt16sle #-}----- Int32------------------------------------------------------------------------------- -- | Serialize an 'Int32' in big endian format.-fromInt32be :: Int32 -> Builder-fromInt32be = fromWriteSingleton writeInt32be+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 = fromWriteList writeInt32be+fromInt32sbe :: [Int32] -> Builder+fromInt32sbe = P.primMapListFixed P.int32BE {-# INLINE fromInt32sbe #-} --- | Serialize an 'Int32' in little endian format.-fromInt32le :: Int32 -> Builder-fromInt32le = fromWriteSingleton writeInt32le-{-# INLINE fromInt32le #-}---- | Serialize a list of 'Int32's in little endian format.-fromInt32sle :: [Int32] -> Builder-fromInt32sle = fromWriteList writeInt32le-{-# INLINE fromInt32sle #-}---- | Serialize an 'Int64' in big endian format.-fromInt64be :: Int64 -> Builder-fromInt64be = fromWriteSingleton writeInt64be-{-# INLINE fromInt64be #-}+-- | 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 = fromWriteList writeInt64be+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 = fromWriteSingleton writeInt64le+fromInt64le :: Int64 -> Builder+fromInt64le = B.int64LE {-# INLINE fromInt64le #-} --- | Serialize a list of 'Int64's in little endian format.-fromInt64sle :: [Int64] -> Builder-fromInt64sle = fromWriteList writeInt64le-{-# INLINE fromInt64sle #-}+-- | 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 #-} ---------------------------------------------------------------------------- Unaligned, integer size ops+-- | 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@@ -255,42 +217,42 @@ -- way are not portable to different endian or integer sized machines, without -- conversion. ---fromInthost :: Int -> Builder-fromInthost = fromWriteSingleton writeInthost+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 = fromWriteList writeInthost+fromIntshost :: [Int] -> Builder+fromIntshost = P.primMapListFixed P.intHost {-# INLINE fromIntshost #-} --- | Write an 'Int16' in native host order and host endianness.-fromInt16host :: Int16 -> Builder-fromInt16host = fromWriteSingleton writeInt16host-{-# INLINE fromInt16host #-}- -- | Write a list of 'Int16's in native host order and host endianness. fromInt16shost :: [Int16] -> Builder-fromInt16shost = fromWriteList writeInt16host+fromInt16shost = P.primMapListFixed P.int16Host {-# INLINE fromInt16shost #-} --- | Write an 'Int32' in native host order and host endianness.-fromInt32host :: Int32 -> Builder-fromInt32host = fromWriteSingleton writeInt32host-{-# INLINE fromInt32host #-}- -- | Write a list of 'Int32's in native host order and host endianness. fromInt32shost :: [Int32] -> Builder-fromInt32shost = fromWriteList writeInt32host+fromInt32shost = P.primMapListFixed P.int32Host {-# INLINE fromInt32shost #-} --- | Write an 'Int64' in native host order and host endianness.-fromInt64host :: Int64 -> Builder-fromInt64host = fromWriteSingleton writeInt64host-{-# INLINE fromInt64host #-}- -- | Write a list of 'Int64's in native host order and host endianness. fromInt64shost :: [Int64] -> Builder-fromInt64shost = fromWriteList writeInt64host+fromInt64shost = P.primMapListFixed P.int64Host {-# INLINE fromInt64shost #-}
− Blaze/ByteString/Builder/Internal.hs
@@ -1,446 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module : Blaze.ByteString.Builder.Internal--- Copyright : (c) 2010 Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only------ Core types and functions for the 'Builder' monoid and the 'Put' monad.----module Blaze.ByteString.Builder.Internal (-- -- * Build Steps- BufRange(..)- , BuildSignal- , BuildStep- , done- , bufferFull- , insertByteString-- -- * Builder- , Builder- , fromBuildStepCont- , fromPut- , flush-- -- * Put- , Put- , putBuilder- , putBuildStepCont- , putLiftIO-- -- * Writes- , module Blaze.ByteString.Builder.Internal.Write- , writeToByteString-- -- * Execution- , toLazyByteString- , toLazyByteStringWith- , toByteString- , toByteStringIO- , toByteStringIOWith-- -- * Deafult Sizes- , defaultFirstBufferSize- , defaultMinimalBufferSize- , defaultBufferSize- , defaultMaximalCopySize-) where--#ifdef HAS_FOREIGN_UNSAFE_MODULE-import Foreign (withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#else-import Foreign (unsafeForeignPtrToPtr, withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)-#endif--import Control.Monad (unless)-#if MIN_VERSION_base(4,4,0)-import System.IO.Unsafe (unsafeDupablePerformIO)-#else-import System.IO.Unsafe (unsafePerformIO)-#endif--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--import Blaze.ByteString.Builder.Internal.Types-import Blaze.ByteString.Builder.Internal.Write----------------------------------------------------------------------------------- Internal global constants.----------------------------------------------------------------------------------- | 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)---- | The minimal length (~4kb) a buffer must have before filling it and--- outputting it as a chunk of the output stream.------ This size determines when a buffer is spilled after a 'flush' or a direct--- bytestring insertion. It is also the size of the first chunk generated by--- 'toLazyByteString'.-defaultMinimalBufferSize :: Int-defaultMinimalBufferSize = 4 * 1024 - overhead- where overhead = 2 * sizeOf (undefined :: Int)---- | The default length (64) for the first buffer to be allocated when--- converting a 'Builder' to a lazy bytestring.------ See 'toLazyByteStringWith' for further explanation.-defaultFirstBufferSize :: Int-defaultFirstBufferSize = 64---- | The maximal number of bytes for that copying is cheaper than direct--- insertion into the output stream. This takes into account the fragmentation--- that may occur in the output buffer due to the early 'flush' implied by the--- direct bytestring insertion.------ @'defaultMaximalCopySize' = 2 * 'defaultMinimalBufferSize'@----defaultMaximalCopySize :: Int-defaultMaximalCopySize = 2 * defaultMinimalBufferSize----------------------------------------------------------------------------------- Flushing and running a Builder----------------------------------------------------------------------------------- | Prepend the chunk if it is non-empty.-{-# INLINE nonEmptyChunk #-}-nonEmptyChunk :: S.ByteString -> L.ByteString -> L.ByteString-nonEmptyChunk bs lbs | S.null bs = lbs- | otherwise = L.Chunk bs lbs----- | Output all data written in the current buffer and start a new chunk.------ The use of this function depends on how the resulting bytestrings are--- consumed. 'flush' is possibly not very useful in non-interactive scenarios.--- However, it is kept for compatibility with the builder provided by--- Data.Binary.Builder.------ When using 'toLazyByteString' to extract a lazy 'L.ByteString' from a--- 'Builder', this means that a new chunk will be started in the resulting lazy--- 'L.ByteString'. The remaining part of the buffer is spilled, if the--- reamining free space is smaller than the minimal desired buffer size.----{-# INLINE flush #-}-flush :: Builder-flush = fromBuildStepCont step- where- step k !(BufRange op _) = return $ insertByteString op S.empty k---- | 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.------ 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 -- ^ Minimal free buffer space for continuing filling- -- the same buffer after a 'flush' or a direct bytestring- -- insertion. This corresponds to the minimal desired- -- chunk size.- -> 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 b) k =- S.inlinePerformIO $ fillFirstBuffer (b (buildStep finalStep))- where- finalStep (BufRange pf _) = return $ Done pf ()- -- fill a first very small buffer, if we need more space then copy it- -- to the new buffer of size 'minBufSize'. This way we don't pay the- -- allocation cost of the big 'bufSize' buffer, when outputting only- -- small sequences.- fillFirstBuffer !step0- | minBufSize <= firstBufSize = fillNewBuffer firstBufSize step0- | otherwise = do- fpbuf <- S.mallocByteString firstBufSize- withForeignPtr fpbuf $ \pf -> do- let !pe = pf `plusPtr` firstBufSize- mkbs pf' = S.PS fpbuf 0 (pf' `minusPtr` pf)- {-# INLINE mkbs #-}- next <- runBuildStep step0 (BufRange pf pe)- case next of- Done pf' _- | pf' == pf -> return k- | otherwise -> return $ L.Chunk (mkbs pf') k-- BufferFull newSize pf' nextStep -> do- let !l = pf' `minusPtr` pf- fillNewBuffer (max (l + newSize) minBufSize) $ buildStep $- \(BufRange pfNew peNew) -> do- copyBytes pfNew pf l- let !br' = BufRange (pfNew `plusPtr` l) peNew- runBuildStep nextStep br'-- InsertByteString pf' bs nextStep- | pf' == pf ->- return $ nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep)- | otherwise ->- return $ L.Chunk (mkbs pf')- (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))-- -- allocate and fill a new buffer- fillNewBuffer !size !step0 = do- fpbuf <- S.mallocByteString size- withForeignPtr fpbuf $ fillBuffer fpbuf- where- fillBuffer fpbuf !pbuf = fill pbuf step0- where- !pe = pbuf `plusPtr` size- fill !pf !step = do- next <- runBuildStep step (BufRange pf pe)- let mkbs pf' = S.PS fpbuf (pf `minusPtr` pbuf) (pf' `minusPtr` pf)- {-# INLINE mkbs #-}- case next of- Done pf' _- | pf' == pf -> return k- | otherwise -> return $ L.Chunk (mkbs pf') k-- BufferFull newSize pf' nextStep- | pf' == pf ->- fillNewBuffer (max newSize bufSize) nextStep- | otherwise ->- return $ L.Chunk (mkbs pf')- (S.inlinePerformIO $- fillNewBuffer (max newSize bufSize) nextStep)-- InsertByteString pf' bs nextStep- | pf' == pf ->- return $ nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep)- | minBufSize < pe `minusPtr` pf' ->- return $ L.Chunk (mkbs pf')- (nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep))- | otherwise ->- return $ L.Chunk (mkbs pf')- (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))----- | Extract the lazy 'L.ByteString' from the builder by running it with default--- buffer sizes. Use this function, if you do not have any special--- considerations with respect to buffer sizes.------ @ 'toLazyByteString' b = 'toLazyByteStringWith' 'defaultBufferSize' 'defaultMinimalBufferSize' 'defaultFirstBufferSize' b L.empty@------ Note that @'toLazyByteString'@ is a 'Monoid' homomorphism.------ > toLazyByteString mempty == mempty--- > toLazyByteString (x `mappend` y) == toLazyByteString x `mappend` toLazyByteString y------ However, in the second equation, the left-hand-side is generally faster to--- execute.----toLazyByteString :: Builder -> L.ByteString-toLazyByteString b = toLazyByteStringWith- defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty-{-# INLINE toLazyByteString #-}---- | 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 . toLazyByteString----- | @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.----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 b) =- fillBuffer bufSize (b (buildStep finalStep))- where- finalStep !(BufRange pf _) = return $ Done pf ()-- fillBuffer !size step = do- S.mallocByteString size >>= fill- where- fill fpbuf = do- let !pf = unsafeForeignPtrToPtr fpbuf- !br = BufRange pf (pf `plusPtr` size)- -- safe due to later reference of fpbuf- -- BETTER than withForeignPtr, as we lose a tail call otherwise- signal <- runBuildStep step br- case signal of- Done pf' _ -> io $ S.PS fpbuf 0 (pf' `minusPtr` pf)-- BufferFull minSize pf' nextStep -> do- io $ S.PS fpbuf 0 (pf' `minusPtr` pf)- fillBuffer (max bufSize minSize) nextStep-- InsertByteString pf' bs nextStep -> do- io $ S.PS fpbuf 0 (pf' `minusPtr` pf)- unless (S.null bs) (io bs)- fillBuffer bufSize nextStep---- | Run the builder with a 'defaultBufferSize'd buffer and execute the given--- 'IO' action whenever the buffer is full or gets flushed.------ @ 'toByteStringIO' = 'toByteStringIOWith' 'defaultBufferSize'@------ This is a 'Monoid' homomorphism in the following sense.------ > toByteStringIO io mempty == return ()--- > toByteStringIO io (x `mappend` y) == toByteStringIO io x >> toByteStringIO io y----toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO ()-toByteStringIO = toByteStringIOWith defaultBufferSize-{-# INLINE toByteStringIO #-}--unsafeIO :: IO a -> a-#if MIN_VERSION_base(4,4,0)-unsafeIO = unsafeDupablePerformIO-#else-unsafeIO = unsafePerformIO-#endif---- | 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 :: Write -> S.ByteString-writeToByteString !w = unsafeIO $ do- fptr <- S.mallocByteString (getBound w)- len <- withForeignPtr fptr $ \ptr -> do- end <- runWrite w ptr- return $! end `minusPtr` ptr- return $! S.fromForeignPtr fptr 0 len-{-# INLINE writeToByteString #-}----------------------------------------------------------------------------------- Draft of new builder/put execution code---------------------------------------------------------------------------------{- FIXME: Generalize this code such that it can replace the above clunky- - implementations.---- | A monad for lazily composing lazy bytestrings using continuations.-newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) }--instance Monad LBSM where- return x = LBSM (x, id)- (LBSM (x,k)) >>= f = let LBSM (x',k') = f x in LBSM (x', k . k')- (LBSM (_,k)) >> (LBSM (x',k')) = LBSM (x', k . k')---- | Execute a put and return the written buffers as the chunks of a lazy--- bytestring.-toLazyByteString :: Put a -> (a, L.ByteString)-toLazyByteString put =- (fst result, k (bufToLBSCont (snd result) L.empty))- where-- -- FIXME: Check with ByteString guys why allocation in inlinePerformIO is- -- bad.-- -- initial buffer- buf0 = S.inlinePerformIO $ allocBuffer defaultBufferSize- -- run put, but don't force result => we're lazy enough- LBSM (result, k) = runPut liftIO outputBuf outputBS put buf0- -- convert a buffer to a lazy bytestring continuation- bufToLBSCont = maybe id L.Chunk . unsafeFreezeNonEmptyBuffer- -- lifting an io putsignal to a lazy bytestring monad- liftIO io = LBSM (S.inlinePerformIO io, id)- -- add buffer as a chunk prepare allocation of new one- outputBuf minSize buf = LBSM- ( S.inlinePerformIO $ allocBuffer (max minSize defaultBufferSize)- , bufToLBSCont buf )- -- add bytestring directly as a chunk; exploits postcondition of runPut- -- that bytestrings are non-empty- outputBS bs = LBSM ((), L.Chunk bs)---{---- | A Builder that traces a message-traceBuilder :: String -> Builder-traceBuilder msg = fromBuildStepCont $ \k br@(BufRange op ope) -> do- putStrLn $ "traceBuilder " ++ show (op, ope) ++ ": " ++ msg- k br--test2 :: Word8 -> [S.ByteString]-test2 x = L.toChunks $ toLazyByteString2 $ fromBuilder $ mconcat- [ traceBuilder "before flush"- , fromWord8 48- , flushBuilder- , flushBuilder- , traceBuilder "after flush"- , fromWord8 x- ]---}---}
− Blaze/ByteString/Builder/Internal/Buffer.hs
@@ -1,223 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module : Blaze.ByteString.Builder.Internal.Buffer--- Copyright : (c) 2010 Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only------ Execution of the 'Put' monad and hence also 'Builder's with respect to--- buffers.----module Blaze.ByteString.Builder.Internal.Buffer (- -- * Buffers- Buffer (..)-- -- ** Status information- , freeSize- , sliceSize- , bufferSize-- -- ** Creation and modification- , allocBuffer- , reuseBuffer- , nextSlice- , updateEndOfSlice- , execBuildStep-- -- ** Conversion to bytestings- , unsafeFreezeBuffer- , unsafeFreezeNonEmptyBuffer-- -- * Buffer allocation strategies- , BufferAllocStrategy- , allNewBuffersStrategy- , reuseBufferStrategy-- -- * Executing puts respect to some monad- , runPut- ) where--#ifdef HAS_FOREIGN_UNSAFE_MODULE-import Foreign (Word8, ForeignPtr, Ptr, plusPtr, minusPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#else-import Foreign (unsafeForeignPtrToPtr, Word8, ForeignPtr, Ptr, plusPtr, minusPtr)-#endif--import qualified Data.ByteString as S--#ifdef BYTESTRING_IN_BASE-import qualified Data.ByteString.Base as S-#else-import qualified Data.ByteString.Internal as S-#endif--import Blaze.ByteString.Builder.Internal.Types---------------------------------------------------------------------------------- Buffers----------------------------------------------------------------------------------- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying--- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free--- space @op..ope@.-data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array- {-# UNPACK #-} !(Ptr Word8) -- beginning of slice- {-# UNPACK #-} !(Ptr Word8) -- next free byte- {-# UNPACK #-} !(Ptr Word8) -- first byte after buffer---- | The size of the free space of the buffer.-freeSize :: Buffer -> Int-freeSize (Buffer _ _ op ope) = ope `minusPtr` op---- | The size of the written slice in the buffer.-sliceSize :: Buffer -> Int-sliceSize (Buffer _ p0 op _) = op `minusPtr` p0---- | The size of the whole byte array underlying the buffer.-bufferSize :: Buffer -> Int-bufferSize (Buffer fpbuf _ _ ope) =- ope `minusPtr` unsafeForeignPtrToPtr fpbuf---- | @allocBuffer size@ allocates a new buffer of size @size@.-{-# INLINE allocBuffer #-}-allocBuffer :: Int -> IO Buffer-allocBuffer size = do- fpbuf <- S.mallocByteString size- let !pbuf = unsafeForeignPtrToPtr fpbuf- return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size)---- | Resets the beginning of the next slice and the next free byte such that--- the whole buffer can be filled again.-{-# INLINE reuseBuffer #-}-reuseBuffer :: Buffer -> Buffer-reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope- where- p0 = unsafeForeignPtrToPtr fpbuf---- | Convert the buffer to a bytestring. This operation is unsafe in the sense--- that created bytestring shares the underlying byte array with the buffer.--- Hence, depending on the later use of this buffer (e.g., if it gets reset and--- filled again) referential transparency may be lost.-{-# INLINE unsafeFreezeBuffer #-}-unsafeFreezeBuffer :: Buffer -> S.ByteString-unsafeFreezeBuffer (Buffer fpbuf p0 op _) =- S.PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0)---- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for--- the explanation of why this operation may be unsafe.-{-# INLINE unsafeFreezeNonEmptyBuffer #-}-unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString-unsafeFreezeNonEmptyBuffer buf- | sliceSize buf <= 0 = Nothing- | otherwise = Just $ unsafeFreezeBuffer buf---- | Update the end of slice pointer.-{-# INLINE updateEndOfSlice #-}-updateEndOfSlice :: Buffer -- Old buffer- -> Ptr Word8 -- New end of slice- -> Buffer -- Updated buffer-updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope---- | Execute a build step on the given buffer.-{-# INLINE execBuildStep #-}-execBuildStep :: BuildStep a- -> Buffer- -> IO (BuildSignal a)-execBuildStep step (Buffer _ _ op ope) = runBuildStep step (BufRange op ope)---- | Move the beginning of the slice to the next free byte such that the--- remaining free space of the buffer can be filled further. This operation--- is safe and can be used to fill the remaining part of the buffer after a--- direct insertion of a bytestring or a flush.-{-# INLINE nextSlice #-}-nextSlice :: Int -> Buffer -> Maybe Buffer-nextSlice minSize (Buffer fpbuf _ op ope)- | ope `minusPtr` op <= minSize = Nothing- | otherwise = Just (Buffer fpbuf op op ope)----------------------------------------------------------------------------------- Buffer allocation strategies----------------------------------------------------------------------------------- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial--- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at--- least size @minSize@ from a filled buffer @buf@. The double nesting of the--- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is--- lost as soon as possible, but the new buffer doesn't have to be allocated--- too early.-type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))---- | The simplest buffer allocation strategy: whenever a buffer is requested,--- allocate a new one that is big enough for the next build step to execute.------ NOTE that this allocation strategy may spill quite some memory upon direct--- insertion of a bytestring by the builder. Thats no problem for garbage--- collection, but it may lead to unreasonably high memory consumption in--- special circumstances.-allNewBuffersStrategy :: Int -- Minimal buffer size.- -> BufferAllocStrategy-allNewBuffersStrategy bufSize =- ( allocBuffer bufSize- , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) )---- | An unsafe, but possibly more efficient buffer allocation strategy:--- reuse the buffer, if it is big enough for the next build step to execute.-reuseBufferStrategy :: IO Buffer- -> BufferAllocStrategy-reuseBufferStrategy buf0 =- (buf0, tryReuseBuffer)- where- tryReuseBuffer reqSize buf- | bufferSize buf >= reqSize = return $ return (reuseBuffer buf)- | otherwise = return $ allocBuffer reqSize----------------------------------------------------------------------------------- Executing puts on a buffer------------------------------------------------------------------------------------ | Execute a put on a buffer.------ TODO: Generalize over buffer allocation strategy.-{-# INLINE runPut #-}-runPut :: Monad m- => (IO (BuildSignal a) -> m (BuildSignal a)) -- lifting of buildsteps- -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next- -> (S.ByteString -> m ()) -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream- -> Put a -- put to execute- -> Buffer -- initial buffer to be used- -> m (a, Buffer) -- result of put and remaining buffer-runPut liftIO outputBuf outputBS (Put put) =- runStep (put (finalStep))- where- finalStep x = buildStep $ \(BufRange op _) -> return $ Done op x-- runStep step buf@(Buffer fpbuf p0 op ope) = do- let !br = BufRange op ope- signal <- liftIO $ runBuildStep step br- case signal of- Done op' x -> -- put completed, buffer partially runSteped- return (x, Buffer fpbuf p0 op' ope)-- BufferFull minSize op' nextStep -> do- buf' <- outputBuf minSize (Buffer fpbuf p0 op' ope)- runStep nextStep buf'-- InsertByteString op' bs nextStep- | S.null bs -> -- flushing of buffer required- outputBuf 1 (Buffer fpbuf p0 op' ope) >>= runStep nextStep- | p0 == op' -> do -- no bytes written: just insert bytestring- outputBS bs- runStep nextStep buf- | otherwise -> do -- bytes written, insert buffer and bytestring- buf' <- outputBuf 1 (Buffer fpbuf p0 op' ope)- outputBS bs- runStep nextStep buf'
− Blaze/ByteString/Builder/Internal/Types.hs
@@ -1,144 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module : Blaze.ByteString.Builder.Internal.Types--- Copyright : (c) 2010 Simon Meier--- License : BSD3-style (see LICENSE)------ Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental--- Portability : tested on GHC only------ Core types and functions for the 'Builder' monoid and the 'Put' monad based--- based on the 'blaze-builder' library by Jasper van der Jeugt and Simon--- Meier.----module Blaze.ByteString.Builder.Internal.Types where--import Control.Applicative--import Data.Monoid-import qualified Data.ByteString as S--import Foreign----------------------------------------------------------------------------------- The core: BuildSteps---------------------------------------------------------------------------------data BufRange = BufRange {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(Ptr Word8)--data BuildSignal a =- Done {-# UNPACK #-} !(Ptr Word8) a- | BufferFull- {-# UNPACK #-} !Int- {-# UNPACK #-} !(Ptr Word8)- !(BuildStep a)- | InsertByteString- {-# UNPACK #-} !(Ptr Word8)- !S.ByteString- !(BuildStep a)--newtype BuildStep a =- BuildStep { runBuildStep :: BufRange -> IO (BuildSignal a) }---- Hiding the implementation of 'BuildStep's--done :: Ptr Word8 -> a -> BuildSignal a-done = Done--bufferFull :: Int -> Ptr Word8 -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a-bufferFull size op step = BufferFull size op (buildStep step)--insertByteString :: Ptr Word8 -> S.ByteString -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a-insertByteString op bs step = InsertByteString op bs (buildStep step)--buildStep :: (BufRange -> IO (BuildSignal a)) -> BuildStep a-buildStep = BuildStep----------------------------------------------------------------------------------- The 'Builder' Monoid and the 'Put' Monad---------------------------------------------------------------------------------newtype Builder = Builder {- unBuilder :: forall r. BuildStep r -> BuildStep r- }--instance Monoid Builder where- mempty = Builder id- {-# INLINE mempty #-}- (Builder b1) `mappend` (Builder b2) = Builder $ b1 . b2- {-# INLINE mappend #-}- mconcat = foldr mappend mempty- {-# INLINE mconcat #-}--newtype Put a = Put {- unPut :: forall r. (a -> BuildStep r) -> BuildStep r- }--instance Functor Put where- fmap f (Put put) = Put $ \k -> put (\x -> k (f x))- {-# INLINE fmap #-}--instance Applicative Put where- pure x = Put $ \k -> k x- {-# INLINE pure #-}- f <*> a = Put $ \k -> unPut f (\f' -> unPut a (\a' -> k (f' a')))- {-# INLINE (<*>) #-}- a <* b = Put $ \k -> unPut a (\a' -> unPut b (\_ -> k a'))- {-# INLINE (<*) #-}- a *> b = Put $ \k -> unPut a (\_ -> unPut b k)- {-# INLINE (*>) #-}--instance Monad Put where- return x = Put $ \k -> k x- {-# INLINE return #-}- m >>= f = Put $ \k -> unPut m (\m' -> unPut (f m') k)- {-# INLINE (>>=) #-}- m >> n = Put $ \k -> unPut m (\_ -> unPut n k)- {-# INLINE (>>) #-}----- Creation from concrete 'BuildStep's---------------------------------------------------------------------------------putBuildStepCont :: (forall r. (a -> BufRange -> IO (BuildSignal r)) ->- ( BufRange -> IO (BuildSignal r))- ) -> Put a-putBuildStepCont step = Put step'- where- step' k = BuildStep $ step (\x -> runBuildStep (k x))---fromBuildStepCont :: (forall r. (BufRange -> IO (BuildSignal r)) ->- (BufRange -> IO (BuildSignal r))- ) -> Builder-fromBuildStepCont step = Builder step'- where- step' k = BuildStep $ step (runBuildStep k)------ Conversion between Put and Builder----------------------------------------------------------------------------------- | Put the given builder.-putBuilder :: Builder -> Put ()-putBuilder (Builder build) = Put $ \k -> build (k ())----- | Ignore the value of a put and only exploit its output side effect.-fromPut :: Put a -> Builder-fromPut (Put put) = Builder $ \k -> put (\_ -> k)---- Lifting IO actions-------------------------- | Lift the given IO action.-{-# INLINE putLiftIO #-}-putLiftIO :: IO a -> Put a-putLiftIO io = putBuildStepCont $ \k br -> io >>= (`k` br)
− Blaze/ByteString/Builder/Internal/UncheckedShifts.hs
@@ -1,78 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module : Blaze.ByteString.Builder.Internal.UncheckedShifts--- 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>--- Stability : experimental--- Portability : tested on GHC only------ Utilty module defining unchecked shifts.----#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-#include "MachDeps.h"-#endif--module Blaze.ByteString.Builder.Internal.UncheckedShifts (- shiftr_w16- , shiftr_w32- , shiftr_w64- ) where---- TODO: Check validity of this implementation--#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------------------------------------------------------------------------------ Unchecked shifts--{-# INLINE shiftr_w16 #-}-shiftr_w16 :: Word16 -> Int -> Word16-{-# INLINE shiftr_w32 #-}-shiftr_w32 :: Word32 -> Int -> Word32-{-# INLINE shiftr_w64 #-}-shiftr_w64 :: Word64 -> Int -> Word64--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)--#if WORD_SIZE_IN_BITS < 64-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)--#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-
Blaze/ByteString/Builder/Internal/Write.hs view
@@ -1,16 +1,13 @@ {-# LANGUAGE CPP, BangPatterns #-} -#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif -- | -- Module : Blaze.ByteString.Builder.Internal.Poke -- Copyright : (c) 2010 Simon Meier -- (c) 2010 Jasper van der Jeugt -- License : BSD3-style (see LICENSE) ----- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- A general and efficient write type that allows for the easy construction of@@ -20,12 +17,11 @@ -- module Blaze.ByteString.Builder.Internal.Write ( -- * Poking a buffer- Poke- , runPoke+ Poke(..) , pokeN -- * Writing to abuffer- , Write+ , Write(..) , runWrite , getBound , getBound'@@ -53,12 +49,11 @@ import Foreign -import Data.Monoid-+import qualified Data.Foldable as F import Control.Monad -import Blaze.ByteString.Builder.Internal.Types-+import Data.ByteString.Builder.Internal+import Data.Semigroup (Semigroup(..)) ------------------------------------------------------------------------------ -- Poking a buffer and writing to a buffer@@ -76,7 +71,7 @@ -- | 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+-- explicitly 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) }@@ -122,27 +117,44 @@ getBound $ write $ error $ "getBound' called from " ++ msg ++ ": write bound is not data-independent." +instance Semigroup Poke where+ {-# INLINE (<>) #-}+ (Poke po1) <> (Poke po2) = Poke $ po1 >=> po2++ {-# INLINE sconcat #-}+ sconcat = F.foldr (<>) mempty+ 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+ mappend = (<>) {-# INLINE mconcat #-}- mconcat = foldr mappend mempty+ mconcat = F.foldr mappend mempty+#endif +instance Semigroup Write where+ {-# INLINE (<>) #-}+ (Write bound1 w1) <> (Write bound2 w2) =+ Write (bound1 + bound2) (w1 <> w2)++ {-# INLINE sconcat #-}+ sconcat = F.foldr (<>) mempty+ 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)+ mappend = (<>) {-# INLINE mconcat #-}- mconcat = foldr mappend mempty-+ mconcat = F.foldr mappend mempty+#endif -- | @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@@@ -150,7 +162,7 @@ {-# INLINE pokeN #-} pokeN :: Int -> (Ptr Word8 -> IO ()) -> Poke-pokeN size io = Poke $ \op -> io op >> return (op `plusPtr` size)+pokeN size io = Poke $ \op -> io op >> (return $! (op `plusPtr` size)) -- | @exactWrite size io@ creates a bounded write that can later be converted to@@ -219,12 +231,12 @@ {-# INLINE fromWrite #-} fromWrite :: Write -> Builder fromWrite (Write maxSize wio) =- fromBuildStepCont step+ builder step where- step k (BufRange op ope)+ step k (BufferRange op ope) | op `plusPtr` maxSize <= ope = do op' <- runPoke wio op- let !br' = BufRange op' ope+ let !br' = BufferRange op' ope k br' | otherwise = return $ bufferFull maxSize op (step k) @@ -233,28 +245,29 @@ fromWriteSingleton write = mkBuilder where- mkBuilder x = fromBuildStepCont step+ mkBuilder x = builder step where- step k (BufRange op ope)+ step k (BufferRange op ope) | op `plusPtr` maxSize <= ope = do op' <- runPoke wio op- let !br' = BufRange op' ope+ 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 = fromBuildStepCont $ step xs0+ makeBuilder xs0 = builder $ step xs0 where- step xs1 k !(BufRange op0 ope0) = go xs1 op0+ step xs1 k !(BufferRange op0 ope0) = go xs1 op0 where go [] !op = do- let !br' = BufRange op ope0+ let !br' = BufferRange op ope0 k br' go xs@(x':xs') !op
Blaze/ByteString/Builder/Word.hs view
@@ -1,21 +1,10 @@-{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module : Blaze.ByteString.Builder.Word--- Copyright : (c) 2010 Jasper Van der Jeugt & 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>--- Stability : experimental--- Portability : tested on GHC only+-- Module: Blaze.ByteString.Builder.Word+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: https://github.com/blaze-builder+-- Stability: stable -- -- 'Write's and 'Builder's for serializing words. --@@ -33,9 +22,8 @@ -- left in the output buffer. Coalescing these checks can improve performance -- quite a bit, as long as you use it sensibly. ---#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-#include "MachDeps.h"-#endif+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.Word ( -- * Writing words to a buffer@@ -96,136 +84,49 @@ ) where -import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Internal.UncheckedShifts--import Foreign----------------------------------------------------------------------------------- Word writes--------------------- Based upon the 'putWordX' functions from "Data.Binary.Builder" from the--- 'binary' package.-----------------------------------------------------------------------------------+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 x = exactWrite 1 (\pf -> poke pf x)+writeWord8 = writePrimFixed P.word8 {-# INLINE writeWord8 #-} ------ We rely on the fromIntegral to do the right masking for us.--- The inlining here is critical, and can be worth 4x performance---- -- | Write a 'Word16' in big endian format. writeWord16be :: Word16 -> Write-writeWord16be w = exactWrite 2 $ \p -> do- poke p (fromIntegral (shiftr_w16 w 8) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (w) :: Word8)+writeWord16be = writePrimFixed P.word16BE {-# INLINE writeWord16be #-} --- | Write a 'Word16' in little endian format.-writeWord16le :: Word16 -> Write-writeWord16le w = exactWrite 2 $ \p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)-{-# INLINE writeWord16le #-}---- writeWord16le w16 = exactWrite 2 (\p -> poke (castPtr p) w16)- -- | Write a 'Word32' in big endian format. writeWord32be :: Word32 -> Write-writeWord32be w = exactWrite 4 $ \p -> do- poke p (fromIntegral (shiftr_w32 w 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (w) :: Word8)+writeWord32be = writePrimFixed P.word32BE {-# INLINE writeWord32be #-} --- | Write a 'Word32' in little endian format.-writeWord32le :: Word32 -> Write-writeWord32le w = exactWrite 4 $ \p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)-{-# INLINE writeWord32le #-}---- on a little endian machine:--- writeWord32le w32 = exactWrite 4 (\p -> poke (castPtr p) w32)- -- | Write a 'Word64' in big endian format. writeWord64be :: Word64 -> Write-#if WORD_SIZE_IN_BITS < 64------ To avoid expensive 64 bit shifts on 32 bit machines, we cast to--- Word32, and write that----writeWord64be w =- let a = fromIntegral (shiftr_w64 w 32) :: Word32- b = fromIntegral w :: Word32- in exactWrite 8 $ \p -> do- poke p (fromIntegral (shiftr_w32 a 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (a) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (b) :: Word8)-#else-writeWord64be w = exactWrite 8 $ \p -> do- poke p (fromIntegral (shiftr_w64 w 56) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (w) :: Word8)-#endif+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--#if WORD_SIZE_IN_BITS < 64-writeWord64le w =- let b = fromIntegral (shiftr_w64 w 32) :: Word32- a = fromIntegral w :: Word32- in exactWrite 8 $ \p -> do- poke (p) (fromIntegral (a) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (b) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 8) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)-#else-writeWord64le w = exactWrite 8 $ \p -> do- poke p (fromIntegral (w) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)-#endif+writeWord64le = writePrimFixed P.word64LE {-# INLINE writeWord64le #-} --- on a little endian machine:--- writeWord64le w64 = exactWrite 8 (\p -> poke (castPtr p) w64)----------------------------------------------------------------------------- Unaligned, word size ops- -- | 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@@ -233,160 +134,135 @@ -- conversion. -- writeWordhost :: Word -> Write-writeWordhost w =- exactWrite (sizeOf (undefined :: Word)) (\p -> poke (castPtr p) w)+writeWordhost = writePrimFixed P.wordHost {-# INLINE writeWordhost #-} -- | Write a 'Word16' in native host order and host endianness. writeWord16host :: Word16 -> Write-writeWord16host w16 =- exactWrite (sizeOf (undefined :: Word16)) (\p -> poke (castPtr p) w16)+writeWord16host = writePrimFixed P.word16Host {-# INLINE writeWord16host #-} -- | Write a 'Word32' in native host order and host endianness. writeWord32host :: Word32 -> Write-writeWord32host w32 =- exactWrite (sizeOf (undefined :: Word32)) (\p -> poke (castPtr p) w32)+writeWord32host = writePrimFixed P.word32Host {-# INLINE writeWord32host #-} -- | Write a 'Word64' in native host order and host endianness. writeWord64host :: Word64 -> Write-writeWord64host w =- exactWrite (sizeOf (undefined :: Word64)) (\p -> poke (castPtr p) w)+writeWord64host = writePrimFixed P.word64Host {-# INLINE writeWord64host #-} ----------------------------------------------------------------------------------- Builders corresponding to the word writes----------------------------------------------------------------------------------- Single bytes-------------------------------------------------------------------------------- -- | Serialize a single byte.--- fromWord8 :: Word8 -> Builder-fromWord8 = fromWriteSingleton writeWord8+fromWord8 = B.word8+{-# INLINE fromWord8 #-} -- | Serialize a list of bytes.--- fromWord8s :: [Word8] -> Builder-fromWord8s = fromWriteList writeWord8----- Word16-------------------------------------------------------------------------------+fromWord8s = P.primMapListFixed P.word8+{-# INLINE fromWord8s #-} -- | Serialize a 'Word16' in big endian format.-fromWord16be :: Word16 -> Builder-fromWord16be = fromWriteSingleton writeWord16be+fromWord16be :: Word16 -> Builder+fromWord16be = B.word16BE {-# INLINE fromWord16be #-} --- | Serialize a list of 'Word16's in big endian format.-fromWord16sbe :: [Word16] -> Builder-fromWord16sbe = fromWriteList writeWord16be-{-# INLINE fromWord16sbe #-}---- | Serialize a 'Word16' in little endian format.-fromWord16le :: Word16 -> Builder-fromWord16le = fromWriteSingleton writeWord16le-{-# INLINE fromWord16le #-}---- | Serialize a list of 'Word16's in little endian format.-fromWord16sle :: [Word16] -> Builder-fromWord16sle = fromWriteList writeWord16le-{-# INLINE fromWord16sle #-}----- Word32------------------------------------------------------------------------------- -- | Serialize a 'Word32' in big endian format.-fromWord32be :: Word32 -> Builder-fromWord32be = fromWriteSingleton writeWord32be+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 = fromWriteList writeWord32be+fromWord32sbe = P.primMapListFixed P.word32BE {-# INLINE fromWord32sbe #-} --- | Serialize a 'Word32' in little endian format.-fromWord32le :: Word32 -> Builder-fromWord32le = fromWriteSingleton writeWord32le-{-# INLINE fromWord32le #-}---- | Serialize a list of 'Word32's in little endian format.-fromWord32sle :: [Word32] -> Builder-fromWord32sle = fromWriteList writeWord32le-{-# INLINE fromWord32sle #-}---- | Serialize a 'Word64' in big endian format.-fromWord64be :: Word64 -> Builder-fromWord64be = fromWriteSingleton writeWord64be-{-# INLINE fromWord64be #-}+-- | 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 = fromWriteList writeWord64be+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 = fromWriteSingleton writeWord64le+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 = fromWriteList writeWord64le+fromWord64sle = P.primMapListFixed P.word64LE {-# INLINE fromWord64sle #-} ----------------------------------------------------------------------------- Unaligned, word size ops- -- | 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 = fromWriteSingleton writeWordhost+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 = fromWriteList writeWordhost+fromWordshost :: [Word] -> Builder+fromWordshost = P.primMapListFixed P.wordHost {-# INLINE fromWordshost #-} --- | Write a 'Word16' in native host order and host endianness.-fromWord16host :: Word16 -> Builder-fromWord16host = fromWriteSingleton writeWord16host-{-# INLINE fromWord16host #-}- -- | Write a list of 'Word16's in native host order and host endianness. fromWord16shost :: [Word16] -> Builder-fromWord16shost = fromWriteList writeWord16host+fromWord16shost = P.primMapListFixed P.word16Host {-# INLINE fromWord16shost #-} --- | Write a 'Word32' in native host order and host endianness.-fromWord32host :: Word32 -> Builder-fromWord32host = fromWriteSingleton writeWord32host-{-# INLINE fromWord32host #-}- -- | Write a list of 'Word32's in native host order and host endianness. fromWord32shost :: [Word32] -> Builder-fromWord32shost = fromWriteList writeWord32host+fromWord32shost = P.primMapListFixed P.word32Host {-# INLINE fromWord32shost #-} -- | Write a 'Word64' in native host order and host endianness.-fromWord64host :: Word64 -> Builder-fromWord64host = fromWriteSingleton writeWord64host-{-# INLINE fromWord64host #-}---- | Write a list of 'Word64's in native host order and host endianness. fromWord64shost :: [Word64] -> Builder-fromWord64shost = fromWriteList writeWord64host+fromWord64shost = P.primMapListFixed P.word64Host {-# INLINE fromWord64shost #-}
+ CHANGELOG.md view
@@ -0,0 +1,184 @@+* 0.4.4.1 2025-08-28+ - Drop unused dependency `deepseq`+ - Tested with GHC 8.0 - 9.14 alpha1++* 0.4.4 2025-07-31+ - Optimization:+ `Blaze.ByteString.Builder.Char.Utf8.fromText = Data.Text.Encoding.encodeUtf8Builder`+ rather than going through `String`.+ (Alex Biehl, PR #11 https://github.com/blaze-builder/blaze-builder/pull/11)+ - Tested with GHC 8.0 - 9.12.2++* 0.4.3 2025-05-15+ - Fix computation of max buffer overhead on 32 bit platforms+ (sternenseemann, PR #8 https://github.com/blaze-builder/blaze-builder/pull/8)+ - Drop support for GHC 7, bytestring < 0.10.4 and text < 1.1.2+ - Tested with GHC 8.0 - 9.12.2++* 0.4.2.3 2023-08-27+ - Fix compilation warnings concerning non-canonical mappend+ - Support bytestring-0.12+ - Support text-2.1+ - Tested with GHC 7.0.4 to 9.8.1 alpha3++* 0.4.2.2+ - Support GHC 9.2++* 0.4.2.1+ - Bump cabal file to Cabal >= 1.10++* 0.4.2.0+ - Make semigroup instances unconditional+ - Support bytestring-0.11+ - Support semigroups-0.19++* 0.4.1.0+ - Gain compatibility with the Semigroup/Monoid proposal+ - Add Word8 HTML escaping builders+ - Speed up `fromHtmlEscapedText` and `fromHtmlEscapedLazyText`++* 0.4.0.2+ - Fixed warnings on GHC 7.10, courtesy of Mikhail Glushenkov.++* 0.4.0.1+ - Tightened the version constraints on the bytestring package for GHC 7.8++* 0.4.0.0+ - This is now a compatibility shim for the new bytestring builder. Most+ of the old internal modules are gone. See this blog post for more+ information:++ <http://blog.melding-monads.com/2015/02/12/announcing-blaze-builder-0-4/>++ - The 'Blaze.ByteString.Builder.Html.Utf8.fromHtmlEscaped*' functions now+ strip out any ASCII control characters present in their inputs. See+ <https://github.com/lpsmith/blaze-builder/issues/1> for more+ information.++* 0.3.3.0+ - exposed the 'Buffer' constructor to enable keeping around a pool of+ buffers.++* 0.3.2.0+ - added 'writeToByteString' to construct a strict bytestring in a single+ step. We can actually view 'Write's as strict-bytestring builders.++* 0.3.1.1+ - Changed imports of Foreign.Unsafe to make it GHC 7.8 compatible+ - -Wall clean on GHC 7.0 - 7.6++* 0.3.1.0+ - Widened dependencies on text and bytestring++* 0.3.0.1++ - Fix build warning in Blaze.ByteString.Builder.Word+ (contributed by Greg Weber)++* 0.3.0.1++ - Remove comparison to the 'text' library encoding functions of+ 'Blaze.Builder.Char.Utf8.fromText' and+ 'Blaze.Builder.Char.Utf8.fromLazyText'. Bryan O'Sullivan reported that on+ his 64-bit system with GHC 7.0.3 the 'text' library is 5x faster than the+ 'blaze-builder' library.++* 0.3.0.0++ - Renamings in internal modules: WriteIO -> Poke and associated functions.++* 0.2.1.4++ - Fixed bug: appending to 'chunkedTransferEncoding somebuilder' also encoded+ the appended builder, which is obviously wrong.++* 0.2.1.3++ - Fixed bug: 'chunkedTransferTerminator' is now correctly set to "0\r\n\r\n".++* 0.2.1.2++ - Add 'MonoPatBinds' language extension to all relevant files to solve the+ issues caused by GHC bug http://hackage.haskell.org/trac/ghc/ticket/4498++* 0.2.1.1++ - Reexport 'Write' datatype and 'fromWriteList', 'fromWriteSingleton',+ 'fromWrite' functions together with writes and builders for storables.+ - Add 'MonoPatBinds' language extension to (hopefully) solve the issues+ caused by GHC bug http://hackage.haskell.org/trac/ghc/ticket/4498++* 0.2.1.0++ Incorporated several design changes:+ - Writable buffer range is now represented in a packed form. This improves+ speed slightly, as less currying is used.+ - Writes are abstracted such that their internal representation can be+ exchanged without breaking other library code.+ - Writes are represented in a form that allows for efficient monoid+ instances for branching code like UTF-8 encoding. For single character+ encoding this results currently in a slight slowdown due to GHC not+ recognizing the strictness of the returned value. This will be fixed in+ the future.+ - BuildSteps support returning a result in `Done`, which enables to+ implement a `Put` monad using CPS.+ - chunked list writes were removed, as they result in worse performance+ when writing non-trivial lists. (cf. benchmarks)+ - An internal buffering abstraction is introduced, which is used both+ by the adaption of the `binary` package, as well as by the+ `blaze-builder-enumeratee` package, to execute puts and builders.+ It will be used later also by the execution functions of the+ `blaze-builder` package.++ Implemented new functionality+ - `Blaze.ByteString.Builder.HTTP` provides a builder transformer for+ doing in-buffer chunked HTTP encoding of an arbitary other builder.+ - `Blaze.ByteString.Builder.Char8` provides functions to serialize the+ lower 8-bits of characters similiar to what `Data.ByteString.Char8`+ provides for bytestrings.++* 0.2.0.3++ Loosen 'text' dependency to '>= 0.10 && < 0.12'++* 0.2.0.2++ Fixed bug: use ' instead of ' for HTML escaping '++* 0.2.0.1++ Added a missing benchmark file.++* blaze-builder-0.2.0.0++ Heavily restructured 'blaze-builder' such that 'Blaze.ByteString.Builder' serves as+ a drop-in replacement of 'binary:Data.Binary.Builder' which it improves upon+ with respect to both speed as well as expressivity. See the documentation and+ the benchmarks for details on improvements and new functionality.++ Changed module structure:+ Blaze.ByteString.Builder.Core -> Blaze.ByteString.Builder+ Blaze.ByteString.Builder.Utf8 -> Blaze.ByteString.Builder.Char.Utf8+ Blaze.ByteString.Builder.Html -> Blaze.ByteString.Builder.Html.Utf8++ Changed function names:+ writeByte -> writeWord8+ fromByte -> fromWord8+ fromWriteList -> fromWrite1List++ Possibly performance sensitive implementation changes:+ - 'fromByteString' and 'fromLazyByteString' check now if a direct insertion+ of the bytestring(s) would be cheaper than copying it. See their+ documentation on how to recover the old behaviour.++ Deprecated functions:+ 'empty' : use 'mempty' instead+ 'singleton': use 'fromWord8' instead+ 'append' : use 'mappend' instead+++* blaze-builder-0.1++ This is the first version of 'blaze-builder'. It is explicitely targeted at+ fast generation of UTF-8 encoded HTML documents in the 'blaze-html' and the+ 'hamlet' HTML templating libraries.
− CHANGES
@@ -1,127 +0,0 @@-* 0.3.3.0- - exposed the 'Buffer' constructor to enable keeping around a pool of- buffers.--* 0.3.2.0- - added 'writeToByteString' to construct a strict bytestring in a single- step. We can actually view 'Write's as strict-bytestring builders.--* 0.3.1.1- - Changed imports of Foreign.Unsafe to make it GHC 7.8 compatible- - -Wall clean on GHC 7.0 - 7.6--* 0.3.1.0- - Widened dependencies on text and bytestring--* 0.3.0.1-- - Fix build warning in Blaze.ByteString.Builder.Word- (contributed by Greg Weber)--* 0.3.0.1-- - Remove comparison to the 'text' library encoding functions of- 'Blaze.Builder.Char.Utf8.fromText' and- 'Blaze.Builder.Char.Utf8.fromLazyText'. Bryan O'Sullivan reported that on- his 64-bit system with GHC 7.0.3 the 'text' library is 5x faster than the- 'blaze-builder' library.--* 0.3.0.0-- - Renamings in internal modules: WriteIO -> Poke and associated functions.--* 0.2.1.4-- - Fixed bug: appending to 'chunkedTransferEncoding somebuilder' also encoded- the appended builder, which is obviously wrong.--* 0.2.1.3-- - Fixed bug: 'chunkedTransferTerminator' is now correctly set to "0\r\n\r\n".--* 0.2.1.2-- - Add 'MonoPatBinds' language extension to all relevant files to solve the- issues caused by GHC bug http://hackage.haskell.org/trac/ghc/ticket/4498--* 0.2.1.1-- - Reexport 'Write' datatype and 'fromWriteList', 'fromWriteSingleton',- 'fromWrite' functions together with writes and builders for storables.- - Add 'MonoPatBinds' language extension to (hopefully) solve the issues- caused by GHC bug http://hackage.haskell.org/trac/ghc/ticket/4498--* 0.2.1.0-- Incorporated several design changes:- - Writable buffer range is now represented in a packed form. This improves- speed slightly, as less currying is used.- - Writes are abstracted such that their internal representation can be- exchanged without breaking other library code.- - Writes are represented in a form that allows for efficient monoid- instances for branching code like UTF-8 encoding. For single character- encoding this results currently in a slight slowdown due to GHC not- recognizing the strictness of the returned value. This will be fixed in- the future.- - BuildSteps support returning a result in `Done`, which enables to- implement a `Put` monad using CPS.- - chunked list writes were removed, as they result in worse performance- when writing non-trivial lists. (cf. benchmarks)- - An internal buffering abstraction is introduced, which is used both- by the adaption of the `binary` package, as well as by the- `blaze-builder-enumeratee` package, to execute puts and builders.- It will be used later also by the execution functions of the- `blaze-builder` package.-- Implemented new functionality- - `Blaze.ByteString.Builder.HTTP` provides a builder transformer for- doing in-buffer chunked HTTP encoding of an arbitary other builder.- - `Blaze.ByteString.Builder.Char8` provides functions to serialize the- lower 8-bits of characters similiar to what `Data.ByteString.Char8`- provides for bytestrings.--* 0.2.0.3-- Loosen 'text' dependency to '>= 0.10 && < 0.12'--* 0.2.0.2-- Fixed bug: use ' instead of ' for HTML escaping '--* 0.2.0.1-- Added a missing benchmark file.--* blaze-builder-0.2.0.0-- Heavily restructured 'blaze-builder' such that 'Blaze.ByteString.Builder' serves as- a drop-in replacement of 'binary:Data.Binary.Builder' which it improves upon- with respect to both speed as well as expressivity. See the documentation and- the benchmarks for details on improvements and new functionality.-- Changed module structure:- Blaze.ByteString.Builder.Core -> Blaze.ByteString.Builder- Blaze.ByteString.Builder.Utf8 -> Blaze.ByteString.Builder.Char.Utf8- Blaze.ByteString.Builder.Html -> Blaze.ByteString.Builder.Html.Utf8-- Changed function names:- writeByte -> writeWord8- fromByte -> fromWord8- fromWriteList -> fromWrite1List-- Possibly performance sensitive implementation changes:- - 'fromByteString' and 'fromLazyByteString' check now if a direct insertion- of the bytestring(s) would be cheaper than copying it. See their- documentation on how to recover the old behaviour.-- Deprecated functions:- 'empty' : use 'mempty' instead- 'singleton': use 'fromWord8' instead- 'append' : use 'mappend' instead---* blaze-builder-0.1-- This is the first version of 'blaze-builder'. It is explicitely targeted at- fast generation of UTF-8 encoded HTML documents in the 'blaze-html' and the- 'hamlet' HTML templating libraries.
Makefile view
@@ -6,12 +6,9 @@ ## Config ######### -GHC6 = ghc-6.12.3-GHC7 = ghc-7.0.2--GHC = $(GHC7)+GHC = ghc -GHCI = ghci-6.12.3+GHCI = ghci ## All benchmarks@@ -51,7 +48,7 @@ ./benchmarks/BlazeVsBinary --resamples 10000 # throughput benchmarks: interactive development-ghci-throughput: benchmarks/Throughput/CBenchmark.o +ghci-throughput: benchmarks/Throughput/CBenchmark.o $(GHCI) -O2 -fforce-recomp -ibenchmarks -main-is BenchThroughput benchmarks/Throughput/CBenchmark.o benchmarks/BenchThroughput.hs bench-throughput: benchmarks/Throughput/CBenchmark.o@@ -146,11 +143,11 @@ clean-tests: rm -f tests/Tests tests/*.o tests/*.hi -ghci-llvm-segfault: - $(GHCI) -itests -main-is LlvmSegfault tests/LlvmSegfault +ghci-llvm-segfault:+ $(GHCI) -itests -main-is LlvmSegfault tests/LlvmSegfault -test-llvm-segfault: - ghc-7.0.0.20100924 --make -fllvm -itests -main-is LlvmSegfault tests/LlvmSegfault +test-llvm-segfault:+ ghc-7.0.0.20100924 --make -fllvm -itests -main-is LlvmSegfault tests/LlvmSegfault ./tests/LlvmSegfault ##############################################################################
README.markdown view
@@ -1,3 +1,8 @@+[](http://hackage.haskell.org/package/blaze-builder)+[](https://stackage.org/nightly/package/blaze-builder)+[](https://www.stackage.org/package/blaze-builder)+[](https://github.com/blaze-builder/blaze-builder/actions)+ blaze-builder ============= @@ -7,24 +12,24 @@ reduces the system call overhead when writing the resulting lazy bytestring to a file or sending it over the network. -This library was inspired by the module Data.Binary.Builder 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+This library was inspired by the module `Data.Binary.Builder` 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. To see the improvements in speed, run the throughput benchmark, which measures-serialization speeds for writing Word8, Word16, Word32 and Word64 in different+serialization speeds for writing `Word8`, `Word16`, `Word32` and `Word64` in different endian formats and different chunk sizes, using the command-+``` make bench-throughput-+``` or run the list serialization comparison benchmark-+``` make bench-blaze-vs-binary--Checkout the combinators in the module "Blaze.ByteString.Builder.Write" to see+```+Checkout the combinators in the module `Blaze.ByteString.Builder.Write` to see the improvements in expressivity. This module allows to incorporate efficient primitive buffer manipulations as parts of a builder. We use this facility-in the 'blaze-html' HTML templating library to allow for the efficient+in the `blaze-html` HTML templating library to allow for the efficient serialization of HTML escaped and UTF-8 encoded characters.
− TODO
@@ -1,73 +0,0 @@--!! UPDATE TODO !!--!! UPDATE BENCHMARKS !!- - * custom serialization functions for lists of 'WordX's- - benchmark chunk size speedup for more complicated computations of list- elements => to be expected that we get no speedup anymore or even a- slowdown => adapt Blaze.ByteString.Builder.Word accordingly.-- * fast serialization for 'Text' values (currently unpacking to 'String' is- the fastest :-/)-- * implementation- - further encodings for 'Char'- - think about end-of-buffer wrapping when copying bytestrings- - toByteStringIO with accumulator capability => provide 'toByteStringIO_'- - allow buildr/foldr deforestation to happen for input to 'fromWrite<n>List'- (or whatever stream fusion framework is in place for lists)- - implement 'toByteString' with an amortized O(n) runtime using the- exponentional scaling trick. If the start size is chosen wisely this- may even be faster than 'S.pack', as the one copy per element is- cheaper than one list thunk per element. It is even likely that we can- amortize three copies per element, which allows to avoid spilling any- buffer space by doing a last compaction copy.- - we could provide builders that honor alignment restrictions, either as- builder transformers or as specialized write to builder converters. The- trick is for the driver to ensure that the buffer beginning is aligned- to the largest aligning (8 or 16 bytes?) required. This is probably the- case by default. Then we can always align a pointer in the buffer by - appropriately aligning the write pointer.-- * extend tests to new functions-- * benchmarks- - understand why the declarative blaze-builder version is the fastest- serializer for Word64 little-endian and big-endian - - check the cost of using `mappend` on builders instead of writes.- - show that using toByteStringIO has an advantage over toLazyByteString- - check performance of toByteStringIO- - compare speed of 'L.pack' to speed of 'toLazyByteString . fromWord8s'-- * documentation- - sort out formultion: "serialization" vs. "encoding"-- * check portability to Hugs-- * performance:- - check if reordering 'pe' and 'pf' change performance; it seems that 'pe'- is only a reader argument while 'pf' is a state argument.- - perhaps we could improve performance by taking page size, page- alignment, and memory access alignment into account.- - detect machine endianness and use host order writes for the supported- endianness.- - introduce a type 'BoundedWrite' that encapsulates a 'Write' generator- with a bound on the number of bytes maximally written by the write.- This way we can achieve data independence for the size check by- sacrificing just a little bit of buffer space at buffer ends.- - investigate where we would profit from static bounds on number of bytes- written (e.g. to make the control flow more linear)-- * testing- - port tests from 'Data.Binary.Builder' to ensure that the word writes- and builders are working correctly. I may have missed some pitfalls- about word types in Haskell during porting the functions from- 'Data.Binary.Builder'.-- * portability- - port to Hugs- - test lower versions of GHC-- * deployment- - add source repository to 'blaze-html' and 'blaze-builder' cabal files
benchmarks/BenchThroughput.hs view
@@ -3,9 +3,9 @@ -- Module : BenchThroughput -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : GHC -- -- This benchmark is based on 'tests/Benchmark.hs' from the 'binary-0.5.0.2'@@ -69,32 +69,32 @@ blazeLineStyle = solidLine 1 . opaque binaryLineStyle = dashedLine 1 [5, 5] . opaque -blazeBuilder = +blazeBuilder = ( "BlazeBuilder" , blazeLineStyle green , supportAllSizes $ BlazeBuilder.serialize) -blazeBuilderDecl = +blazeBuilderDecl = ( "BlazeBuilderDecl" , blazeLineStyle blue , supportAllSizes $ BlazeBuilderDecl.serialize) -blazePut = +blazePut = ( "BlazePut" , blazeLineStyle red , supportAllSizes $ BlazePut.serialize) -binaryBuilder = +binaryBuilder = ( "BinaryBuilder" , binaryLineStyle green , supportAllSizes $ BinaryBuilder.serialize) -binaryBuilderDecl = +binaryBuilderDecl = ( "BinaryBuilderDecl" , binaryLineStyle blue , BinaryBuilderDecl.serialize) -binaryPut = +binaryPut = ( "BinaryPut" , binaryLineStyle red , supportAllSizes $ BinaryPut.serialize)@@ -103,11 +103,11 @@ main :: IO () main = do mb <- getArgs >>= readIO . head- -- memBench (mb*10) + -- memBench (mb*10) putStrLn "" putStrLn "Binary serialisation benchmarks:" - -- do bytewise + -- do bytewise -- sequence_ -- [ test wordSize chunkSize Host mb -- | wordSize <- [1]@@ -116,15 +116,15 @@ -- now Word16 .. Word64 let lift f wS cS e i = return $ f wS cS e i- serializers = + serializers = [ blazeBuilder , blazeBuilderDecl , blazePut , binaryBuilder, binaryBuilderDecl, binaryPut ] wordSizes = [1,2,4,8]- chunkSizes = [1,2,4,8,16] + chunkSizes = [1,2,4,8,16] endians = [Host,Big,Little] - let compares = + let compares = [ compareResults serialize wordSize chunkSize end mb | wordSize <- wordSizes , chunkSize <- chunkSizes@@ -136,7 +136,7 @@ -- sequence_ compares - let serializes = + let serializes = [ [ ( serialize , [ (chunkSize, test serialize wordSize chunkSize end mb) | chunkSize <- [1,2,4,8,16]@@ -160,20 +160,20 @@ let plottedLines = flip map lines $ \ ((name,lineStyle,_), points) -> plot_lines_title ^= name $ plot_lines_style ^= lineStyle $- plot_lines_values ^= [points] $ + plot_lines_values ^= [points] $ defaultPlotLines- let layout = + let layout = defaultLayout1 { layout1_plots_ = map (Right . toPlot) plottedLines } return ()- -- renderableToWindow (toRenderable layout) 640 480 + -- renderableToWindow (toRenderable layout) 640 480 measureSerializer :: (a, [(Int, IO (Maybe Double))]) -> IO (Maybe (a, [(Int,Double)])) measureSerializer (info, tests) = do optPoints <- forM tests $ \ (x, test) -> do optY <- test- case optY of + case optY of Nothing -> return Nothing Just y -> return $ Just (x, y) case catMaybes optPoints of@@ -191,7 +191,7 @@ ------------------------------------------------------------------------ -test :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) +test :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) -> Int -> Int -> Endian -> Int -> IO (Maybe Double) test (serializeName, _, serialize) wordSize chunkSize end mb = do let bytes :: Int@@ -213,13 +213,13 @@ putThroughput -- getThroughput -- (getThroughput/putThroughput)- + hFlush stdout return $ Just putThroughput ------------------------------------------------------------------------ -compareResults :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) +compareResults :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) -> Int -> Int -> Endian -> Int -> IO () compareResults (serializeName, _, serialize) wordSize chunkSize end mb0 = do let mb :: Int@@ -233,8 +233,7 @@ Just bs1 -> do _ <- printf "%17s: %dMB of Word%-2d in chunks of %2d (%6s endian):" serializeName (mb :: Int) (8 * wordSize :: Int) (chunkSize :: Int) (show end)- if (bs0 == bs1) + if (bs0 == bs1) then putStrLn " Ok" else putStrLn " Failed" hFlush stdout-
benchmarks/BenchmarkServer.hs view
@@ -8,7 +8,7 @@ import Prelude hiding (putStrLn) import Data.Char (ord)-import Data.Monoid +import Data.Monoid import Data.ByteString.Char8 () -- IsString instance only import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -16,7 +16,7 @@ import Control.Concurrent (forkIO, putMVar, takeMVar, newEmptyMVar) import Control.Exception (bracket)-import Control.Monad +import Control.Monad import Network.Socket (Socket, accept, sClose) import Network (listenOn, PortID (PortNumber))@@ -31,15 +31,15 @@ import Criterion.Main -httpOkHeader :: S.ByteString -httpOkHeader = S.concat +httpOkHeader :: S.ByteString+httpOkHeader = S.concat [ "HTTP/1.1 200 OK\r\n" , "Content-Type: text/html; charset=UTF-8\r\n" , "\r\n" ] response :: Int -> Builder-response n = - fromByteString httpOkHeader `mappend` +response n =+ fromByteString httpOkHeader `mappend` fromString (take n $ cycle "hello λ-world! ") sendVectoredBuilderLBS :: Socket -> Builder -> IO ()@@ -47,7 +47,7 @@ {-# NOINLINE sendVectoredBuilderLBS #-} sendBuilderLBS :: Socket -> Builder -> IO ()-sendBuilderLBS s = +sendBuilderLBS s = -- mapM_ (S.sendAll s) . L.toChunks . toLazyByteString L.foldrChunks (\c -> (S.sendAll s c >>)) (return ()). toLazyByteString {-# NOINLINE sendBuilderLBS #-}@@ -58,7 +58,7 @@ -- criterion benchmark determining the speed of response main2 = defaultMain- [ bench ("response " ++ show n) $ whnf + [ bench ("response " ++ show n) $ whnf (L.length . toLazyByteString . response) n ] where@@ -69,12 +69,12 @@ main = do [port, nChars] <- map read `liftM` getArgs killSignal <- newEmptyMVar- bracket (listenOn . PortNumber . fromIntegral $ port) sClose + bracket (listenOn . PortNumber . fromIntegral $ port) sClose (\socket -> do _ <- forkIO $ loop (putMVar killSignal ()) nChars socket takeMVar killSignal) where- loop killServer nChars socket = forever $ do + loop killServer nChars socket = forever $ do (s, _) <- accept socket forkIO (respond s nChars) where
benchmarks/BlazeVsBinary.hs view
@@ -3,9 +3,9 @@ -- Module : BlazeVsBinary -- Copyright : (c) 2010 Jasper Van der Jeught & Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- A comparison between 'blaze-builder' and the Data.Binary.Builder from
benchmarks/BoundedWrite.hs view
@@ -3,9 +3,9 @@ -- Module : BoundedWrite -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- A more general/efficient write type.@@ -22,8 +22,8 @@ import qualified Data.ByteString.Lazy as L import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Write -import Blaze.ByteString.Builder.Word +import Blaze.ByteString.Builder.Write+import Blaze.ByteString.Builder.Word import Criterion.Main @@ -92,7 +92,7 @@ ------------------------------------------------------------------------------ -- * GRRR* GHC is too 'clever'... code where we branch and each branch should--- execute a few IO actions and then return a value cannot be taught to GHC. +-- 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 BWrite@@ -129,7 +129,7 @@ staticBWrite size io = BWrite size (execWriteSize io size) {-# INLINE staticBWrite #-} -bwriteWord8 :: Word8 -> BWrite +bwriteWord8 :: Word8 -> BWrite bwriteWord8 x = staticBWrite 1 (`poke` x) {-# INLINE bwriteWord8 #-} @@ -145,7 +145,7 @@ {-# INLINE fromBWrite #-} fromBWriteSingleton :: (a -> BWrite) -> a -> Builder-fromBWriteSingleton write = +fromBWriteSingleton write = mkPut where mkPut x = Builder step@@ -238,4 +238,3 @@ x4 = fromIntegral $ (x .&. 0x3F) + 0x80 in f4 x1 x2 x3 x4 {-# INLINE encodeCharUtf8 #-}-
benchmarks/BuilderBufferRange.hs view
@@ -3,9 +3,9 @@ -- Module : BuilderBufferRange -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Benchmark the benefit of using a packed representation for the buffer range.@@ -71,7 +71,7 @@ -- The Builder type ------------------------------------------------------------------------------ -data BufferRange = BR {-# UNPACK #-} !(Ptr Word8) +data BufferRange = BR {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(Ptr Word8) newtype Put = Put (PutStep -> PutStep)@@ -83,8 +83,8 @@ {-# UNPACK #-} !(Ptr Word8) !PutStep | ModifyChunks- {-# UNPACK #-} !(Ptr Word8) - !(L.ByteString -> L.ByteString) + {-# UNPACK #-} !(Ptr Word8)+ !(L.ByteString -> L.ByteString) !PutStep type PutStep = BufferRange -> IO PutSignal@@ -110,7 +110,7 @@ {-# INLINE putWrite #-} putWriteSingleton :: (a -> Write) -> a -> Put-putWriteSingleton write = +putWriteSingleton write = mkPut where mkPut x = Put step@@ -126,7 +126,7 @@ {-# INLINE putWriteSingleton #-} putBuilder :: B.Builder -> Put-putBuilder (B.Builder b) = +putBuilder (B.Builder b) = Put step where finalStep _ pf = return $ B.Done pf@@ -139,9 +139,9 @@ B.Done pf' -> do let !br' = BR pf' pe k br'- B.BufferFull minSize pf' nextBuildStep -> + B.BufferFull minSize pf' nextBuildStep -> return $ BufferFull minSize pf' (go nextBuildStep)- B.ModifyChunks _ _ _ -> + B.ModifyChunks _ _ _ -> error "putBuilder: ModifyChunks not implemented" putWord8 :: Word8 -> Put@@ -149,7 +149,7 @@ {- m >>= f = GetC $ \done empty pe ->- runGetC m (\pr' x -> runGetC (f x) done empty pe pr') + runGetC m (\pr' x -> runGetC (f x) done empty pe pr') (\m' -> empty (m' >>= f)) pe @@ -165,13 +165,13 @@ instance Functor (GetC r) where fmap f g = GetC $ \done empty ->- runGetC g (\pr' x -> done pr' (f x)) + runGetC g (\pr' x -> done pr' (f x)) (\g' -> empty (fmap f g')) instance Monad (GetC r) where return x = GetC $ \done _ _ pr -> done pr x m >>= f = GetC $ \done empty pe ->- runGetC m (\pr' x -> runGetC (f x) done empty pe pr') + runGetC m (\pr' x -> runGetC (f x) done empty pe pr') (\m' -> empty (m' >>= f)) pe @@ -189,7 +189,7 @@ where overhead = 2 * sizeOf (undefined :: Int) -- | The minimal length (~4kb) a buffer must have before filling it and--- outputting it as a chunk of the output stream. +-- outputting it as a chunk of the output stream. -- -- This size determines when a buffer is spilled after a 'flush' or a direct -- bytestring insertion. It is also the size of the first chunk generated by@@ -199,7 +199,7 @@ where overhead = 2 * sizeOf (undefined :: Int) -- | The default length (64) for the first buffer to be allocated when--- converting a 'Builder' to a lazy bytestring. +-- converting a 'Builder' to a lazy bytestring. -- -- See 'toLazyByteStringWith' for further explanation. defaultFirstBufferSize :: Int@@ -263,7 +263,7 @@ -- @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 +toLazyByteStringWith :: Int -- ^ Buffer size (upper-bounds the resulting chunk size). -> Int -- ^ Minimal free buffer space for continuing filling -- the same buffer after a 'flush' or a direct bytestring@@ -275,7 +275,7 @@ -> L.ByteString -- ^ Lazy bytestring to output after the builder is -- finished. -> L.ByteString -- ^ Resulting lazy bytestring-toLazyByteStringWith bufSize minBufSize firstBufSize (Put b) k = +toLazyByteStringWith bufSize minBufSize firstBufSize (Put b) k = inlinePerformIO $ fillFirstBuffer (b finalStep) where finalStep (BR pf _) = return $ Done pf@@ -304,14 +304,14 @@ copyBytes pfNew pf l let !brNew = BR (pfNew `plusPtr` l) peNew nextStep brNew- - ModifyChunks pf' bsk nextStep ++ ModifyChunks pf' bsk nextStep | pf' == pf -> return $ bsk (inlinePerformIO $ fillNewBuffer bufSize nextStep) | otherwise -> return $ L.Chunk (mkbs pf') (bsk (inlinePerformIO $ fillNewBuffer bufSize nextStep))- + -- allocate and fill a new buffer fillNewBuffer !size !step0 = do fpbuf <- S.mallocByteString size@@ -332,9 +332,9 @@ BufferFull newSize pf' nextStep -> return $ L.Chunk (mkbs pf')- (inlinePerformIO $ + (inlinePerformIO $ fillNewBuffer (max newSize bufSize) nextStep)- + ModifyChunks pf' bsk nextStep | pf' == pf -> return $ bsk (inlinePerformIO $ fill pf' nextStep)@@ -361,7 +361,7 @@ -- execute. -- toLazyByteString :: Put -> L.ByteString-toLazyByteString b = toLazyByteStringWith +toLazyByteString b = toLazyByteStringWith defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty {-# INLINE toLazyByteString #-} @@ -415,7 +415,7 @@ -- 'S.ByteString'. -> Builder -- ^ 'Builder' to run. -> IO () -- ^ Resulting 'IO' action.-toByteStringIOWith bufSize io (Builder b) = +toByteStringIOWith bufSize io (Builder b) = fillNewBuffer bufSize (b finalStep) where finalStep pf _ = return $ Done pf@@ -439,7 +439,7 @@ if bufSize < newSize then fillNewBuffer newSize nextStep else fill nextStep- + ModifyChunks pf' bsk nextStep -> do unless (pf' == pf) (io $ S.PS fpbuf 0 (pf' `minusPtr` pf)) -- was: mapM_ io $ L.toChunks (bsk L.empty)
benchmarks/ChunkedWrite.hs view
@@ -3,9 +3,9 @@ -- Module : ChunkedWrite -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Test different strategies for writing lists of simple values:@@ -32,53 +32,53 @@ import qualified Blaze.ByteString.Builder.Char.Utf8 as BB main :: IO ()-main = defaultMain - [ bench "S.pack: [Word8] -> S.ByteString" $ +main = defaultMain+ [ bench "S.pack: [Word8] -> S.ByteString" $ whnf (S.pack) word8s - , bench "toByteString . fromWord8s: [Word8] -> Builder -> S.ByteString" $ + , bench "toByteString . fromWord8s: [Word8] -> Builder -> S.ByteString" $ whnf (BB.toByteString . BB.fromWord8s) word8s - , bench "L.pack: [Word8] -> L.ByteString" $ + , bench "L.pack: [Word8] -> L.ByteString" $ whnf (L.length . L.pack) word8s - , bench "mconcat . map fromByte: [Word8] -> Builder -> L.ByteString" $ + , bench "mconcat . map fromByte: [Word8] -> Builder -> L.ByteString" $ whnf benchMConcatWord8s word8s- , bench "fromWrite1List: [Word8] -> Builder -> L.ByteString" $ + , bench "fromWrite1List: [Word8] -> Builder -> L.ByteString" $ whnf bench1Word8s word8s- , bench "fromWrite2List: [Word8] -> Builder -> L.ByteString" $ + , bench "fromWrite2List: [Word8] -> Builder -> L.ByteString" $ whnf bench2Word8s word8s- , bench "fromWrite4List: [Word8] -> Builder -> L.ByteString" $ + , bench "fromWrite4List: [Word8] -> Builder -> L.ByteString" $ whnf bench4Word8s word8s- , bench "fromWrite8List: [Word8] -> Builder -> L.ByteString" $ + , bench "fromWrite8List: [Word8] -> Builder -> L.ByteString" $ whnf bench8Word8s word8s- , bench "fromWrite16List: [Word8] -> Builder -> L.ByteString" $ + , bench "fromWrite16List: [Word8] -> Builder -> L.ByteString" $ whnf bench16Word8s word8s - , bench "mconcat . map fromByte: [Char] -> Builder -> L.ByteString" $ + , bench "mconcat . map fromByte: [Char] -> Builder -> L.ByteString" $ whnf benchMConcatChars chars- , bench "fromWrite1List: [Char] -> Builder -> L.ByteString" $ + , bench "fromWrite1List: [Char] -> Builder -> L.ByteString" $ whnf bench1Chars chars- , bench "fromWrite2List: [Char] -> Builder -> L.ByteString" $ + , bench "fromWrite2List: [Char] -> Builder -> L.ByteString" $ whnf bench2Chars chars- , bench "fromWrite4List: [Char] -> Builder -> L.ByteString" $ + , bench "fromWrite4List: [Char] -> Builder -> L.ByteString" $ whnf bench4Chars chars- , bench "fromWrite8List: [Char] -> Builder -> L.ByteString" $ + , bench "fromWrite8List: [Char] -> Builder -> L.ByteString" $ whnf bench8Chars chars- , bench "fromWrite16List: [Char] -> Builder -> L.ByteString" $ + , bench "fromWrite16List: [Char] -> Builder -> L.ByteString" $ whnf bench16Chars chars - , bench "mconcat . map fromWord32host: [Word32] -> Builder -> L.ByteString" $ + , bench "mconcat . map fromWord32host: [Word32] -> Builder -> L.ByteString" $ whnf benchMConcatWord32s word32s- , bench "fromWrite1List: [Word32] -> Builder -> L.ByteString" $ + , bench "fromWrite1List: [Word32] -> Builder -> L.ByteString" $ whnf bench1Word32s word32s- , bench "fromWrite2List: [Word32] -> Builder -> L.ByteString" $ + , bench "fromWrite2List: [Word32] -> Builder -> L.ByteString" $ whnf bench2Word32s word32s- , bench "fromWrite4List: [Word32] -> Builder -> L.ByteString" $ + , bench "fromWrite4List: [Word32] -> Builder -> L.ByteString" $ whnf bench4Word32s word32s- , bench "fromWrite8List: [Word32] -> Builder -> L.ByteString" $ + , bench "fromWrite8List: [Word32] -> Builder -> L.ByteString" $ whnf bench8Word32s word32s- , bench "fromWrite16List: [Word32] -> Builder -> L.ByteString" $ + , bench "fromWrite16List: [Word32] -> Builder -> L.ByteString" $ whnf bench16Word32s word32s ] where@@ -155,4 +155,3 @@ bench16Word32s :: [Word32] -> Int64 bench16Word32s = L.length . BB.toLazyByteString . BB.fromWrite16List BB.writeWord32host-
benchmarks/Compression.hs view
@@ -2,9 +2,9 @@ -- Module : Compression -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Benchmark the effect of first compacting the input stream for the 'zlib'@@ -27,7 +27,7 @@ import qualified Blaze.ByteString.Builder as B import Codec.Compression.GZip -main = defaultMain +main = defaultMain [ bench "compress directly (chunksize 10)" $ whnf benchCompressDirectly byteString10 , bench "compress compacted (chunksize 10)" $@@ -51,5 +51,5 @@ benchCompressDirectly = L.length . compress benchCompressCompacted :: L.ByteString -> Int64-benchCompressCompacted = +benchCompressCompacted = L.length . compress . B.toLazyByteString . B.fromLazyByteString
benchmarks/FastPut.hs view
@@ -3,9 +3,9 @@ -- Module : FastPut -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Implementation of a 'Put' monad with similar performance characteristics@@ -88,7 +88,7 @@ {-# UNPACK #-} !(Ptr Word8) !(PutStep a) | InsertByteString- {-# UNPACK #-} !(Ptr Word8) + {-# UNPACK #-} !(Ptr Word8) !S.ByteString !(PutStep a) @@ -135,7 +135,7 @@ {-# INLINE fromWrite #-} fromWriteSingleton :: (a -> Write) -> a -> Builder-fromWriteSingleton write = +fromWriteSingleton write = mkPut where mkPut x = Builder step@@ -174,7 +174,7 @@ {-# INLINE putWrite #-} putWriteSingleton :: (a -> Write) -> a -> Put ()-putWriteSingleton write = +putWriteSingleton write = mkPut where mkPut x = Put step@@ -190,7 +190,7 @@ {-# INLINE putWriteSingleton #-} putBuilder :: B.Builder -> Put ()-putBuilder (B.Builder b) = +putBuilder (B.Builder b) = Put step where finalStep _ pf = return $ B.Done pf@@ -203,14 +203,14 @@ B.Done pf' -> do let !br' = BufRange pf' pe k () br'- B.BufferFull minSize pf' nextBuildStep -> + B.BufferFull minSize pf' nextBuildStep -> return $ BufferFull minSize pf' (go nextBuildStep)- B.ModifyChunks _ _ _ -> + B.ModifyChunks _ _ _ -> error "putBuilder: ModifyChunks not implemented" {- m >>= f = GetC $ \done empty pe ->- runGetC m (\pr' x -> runGetC (f x) done empty pe pr') + runGetC m (\pr' x -> runGetC (f x) done empty pe pr') (\m' -> empty (m' >>= f)) pe @@ -226,13 +226,13 @@ instance Functor (GetC r) where fmap f g = GetC $ \done empty ->- runGetC g (\pr' x -> done pr' (f x)) + runGetC g (\pr' x -> done pr' (f x)) (\g' -> empty (fmap f g')) instance Monad (GetC r) where return x = GetC $ \done _ _ pr -> done pr x m >>= f = GetC $ \done empty pe ->- runGetC m (\pr' x -> runGetC (f x) done empty pe pr') + runGetC m (\pr' x -> runGetC (f x) done empty pe pr') (\m' -> empty (m' >>= f)) pe @@ -250,7 +250,7 @@ where overhead = 2 * sizeOf (undefined :: Int) -- | The minimal length (~4kb) a buffer must have before filling it and--- outputting it as a chunk of the output stream. +-- outputting it as a chunk of the output stream. -- -- This size determines when a buffer is spilled after a 'flush' or a direct -- bytestring insertion. It is also the size of the first chunk generated by@@ -260,7 +260,7 @@ where overhead = 2 * sizeOf (undefined :: Int) -- | The default length (64) for the first buffer to be allocated when--- converting a 'Builder' to a lazy bytestring. +-- converting a 'Builder' to a lazy bytestring. -- -- See 'toLazyByteStringWith' for further explanation. defaultFirstBufferSize :: Int@@ -291,7 +291,7 @@ -- When using 'toLazyByteString' to extract a lazy 'L.ByteString' from a -- 'Builder', this means that a new chunk will be started in the resulting lazy -- 'L.ByteString'. The remaining part of the buffer is spilled, if the--- reamining free space is smaller than the minimal desired buffer size.+-- remaining free space is smaller than the minimal desired buffer size. -- {- flush :: Builder@@ -324,7 +324,7 @@ -- @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 +toLazyByteStringWith :: Int -- ^ Buffer size (upper-bounds the resulting chunk size). -> Int -- ^ Minimal free buffer space for continuing filling -- the same buffer after a 'flush' or a direct bytestring@@ -336,7 +336,7 @@ -> L.ByteString -- ^ Lazy bytestring to output after the builder is -- finished. -> L.ByteString -- ^ Resulting lazy bytestring-toLazyByteStringWith bufSize minBufSize firstBufSize (Put b) k = +toLazyByteStringWith bufSize minBufSize firstBufSize (Put b) k = inlinePerformIO $ fillFirstBuffer (b finalStep) where finalStep _ (BufRange pf _) = return $ Done pf undefined@@ -365,17 +365,17 @@ copyBytes pfNew pf l let !brNew = BufRange (pfNew `plusPtr` l) peNew nextStep brNew- + InsertByteString _ _ _ -> error "not yet implemented" {-- ModifyChunks pf' bsk nextStep( + ModifyChunks pf' bsk nextStep( | pf' == pf -> return $ bsk (inlinePerformIO $ fillNewBuffer bufSize nextStep) | otherwise -> return $ L.Chunk (mkbs pf') (bsk (inlinePerformIO $ fillNewBuffer bufSize nextStep)) -}- + -- allocate and fill a new buffer fillNewBuffer !size !step0 = do fpbuf <- S.mallocByteString size@@ -396,9 +396,9 @@ BufferFull newSize pf' nextStep -> return $ L.Chunk (mkbs pf')- (inlinePerformIO $ + (inlinePerformIO $ fillNewBuffer (max newSize bufSize) nextStep)- + InsertByteString _ _ _ -> error "not yet implemented2" {- ModifyChunks pf' bsk nextStep@@ -428,7 +428,7 @@ -- execute. -- toLazyByteString :: Put a -> L.ByteString-toLazyByteString b = toLazyByteStringWith +toLazyByteString b = toLazyByteStringWith defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty {-# INLINE toLazyByteString #-} @@ -436,11 +436,11 @@ -- Builder Enumeration ------------------------------------------------------------------------------ -data BuildStream a = +data BuildStream a = BuildChunk S.ByteString (IO (BuildStream a)) | BuildYield- a - (forall b. Bool -> + a+ (forall b. Bool -> Either (Maybe S.ByteString) (Put b -> IO (BuildStream b))) enumPut :: Int -> Put a -> IO (BuildStream a)@@ -452,16 +452,16 @@ fillBuffer :: forall b. Int -> PutStep b -> IO (BuildStream b) fillBuffer size step = do- fpbuf <- S.mallocByteString bufSize + fpbuf <- S.mallocByteString bufSize let !pbuf = unsafeForeignPtrToPtr fpbuf -- safe due to later reference of fpbuf -- BETTER than withForeignPtr, as we lose a tail call otherwise !br = BufRange pbuf (pbuf `plusPtr` size) fillStep fpbuf br step - fillPut :: ForeignPtr Word8 -> BufRange -> + fillPut :: ForeignPtr Word8 -> BufRange -> Bool -> Either (Maybe S.ByteString) (Put b -> IO (BuildStream b))- fillPut !fpbuf !(BufRange op _) False + fillPut !fpbuf !(BufRange op _) False | pbuf == op = Left Nothing | otherwise = Left $ Just $ S.PS fpbuf 0 (op `minusPtr` pbuf)@@ -481,11 +481,11 @@ let !br' = BufRange op' ope return $ BuildYield x (fillPut fpbuf br') - BufferFull minSize op' nextStep + BufferFull minSize op' nextStep | pbuf == op' -> do -- nothing written, larger buffer required fillBuffer (max bufSize minSize) nextStep | otherwise -> do -- some bytes written, new buffer required- return $ BuildChunk + return $ BuildChunk (S.PS fpbuf 0 (op' `minusPtr` pbuf)) (fillBuffer (max bufSize minSize) nextStep) @@ -501,25 +501,25 @@ toLazyByteString' :: Put () -> L.ByteString-toLazyByteString' put = +toLazyByteString' put = inlinePerformIO (consume `fmap` enumPut defaultBufferSize put) where consume :: BuildStream () -> L.ByteString- consume (BuildYield _ f) = + consume (BuildYield _ f) = case f False of Left Nothing -> L.Empty Left (Just bs) -> L.Chunk bs L.Empty Right _ -> error "toLazyByteString': enumPut violated postcondition" consume (BuildChunk bs ioStream) = L.Chunk bs $ inlinePerformIO (consume `fmap` ioStream)- + {- BufferFull minSize pf' nextStep -> do io $ S.PS fpbuf 0 (pf' `minusPtr` pf) fillBuffer (max bufSize minSize) nextStep- + ModifyChunks pf' bsk nextStep -> do io $ S.PS fpbuf 0 (pf' `minusPtr` pf) L.foldrChunks (\bs -> (io bs >>)) (return ()) (bsk L.empty)@@ -543,11 +543,11 @@ return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size) unsafeFreezeBuffer :: Buffer -> S.ByteString-unsafeFreezeBuffer (Buffer fpbuf p0 op _) = +unsafeFreezeBuffer (Buffer fpbuf p0 op _) = S.PS fpbuf 0 (op `minusPtr` p0) unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString-unsafeFreezeNonEmptyBuffer (Buffer fpbuf p0 op _) +unsafeFreezeNonEmptyBuffer (Buffer fpbuf p0 op _) | p0 == op = Nothing | otherwise = Just $ S.PS fpbuf 0 (op `minusPtr` p0) @@ -556,7 +556,7 @@ | ope `minusPtr` op <= minSize = Nothing | otherwise = Just (Buffer fpbuf op op ope) -runPut :: Monad m +runPut :: Monad m => (IO (PutSignal a) -> m (PutSignal a)) -- lifting of buildsteps -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next -> (S.ByteString -> m ()) -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream@@ -571,7 +571,7 @@ runStep step buf@(Buffer fpbuf p0 op ope) = do let !br = BufRange op ope signal <- liftIO $ step br- case signal of + case signal of Done op' x -> -- put completed, buffer partially runSteped return (x, Buffer fpbuf p0 op' ope) @@ -590,7 +590,7 @@ outputBS bs runStep nextStep buf' {-# INLINE runPut #-}- + -- | A monad for lazily composing lazy bytestrings using continuations. newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) } @@ -602,7 +602,7 @@ -- | Execute a put and return the written buffers as the chunks of a lazy -- bytestring. toLazyByteString2 :: Put a -> L.ByteString-toLazyByteString2 put = +toLazyByteString2 put = k (bufToLBSCont (snd result) L.empty) where -- initial buffer@@ -622,7 +622,7 @@ outputBS bs = LBSM ((), L.Chunk bs) -- | A Builder that traces a message-traceBuilder :: String -> Builder +traceBuilder :: String -> Builder traceBuilder msg = Builder $ \k br@(BufRange op ope) -> do putStrLn $ "traceBuilder " ++ show (op, ope) ++ ": " ++ msg k br@@ -633,11 +633,10 @@ test2 :: Word8 -> [S.ByteString] test2 x = L.toChunks $ toLazyByteString2 $ fromBuilder $ mconcat- [ traceBuilder "before flush" + [ traceBuilder "before flush" , fromWord8 48 , flushBuilder , flushBuilder , traceBuilder "after flush" , fromWord8 x ]-
benchmarks/LazyByteString.hs view
@@ -3,9 +3,9 @@ -- Module : LazyByteString -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Benchmarking of alternative implementations of functions in@@ -15,14 +15,14 @@ import Data.Char import Data.Word-import Data.Monoid -import Data.List +import Data.Monoid+import Data.List import Control.Monad import Control.Arrow (second) import Criterion.Main -import Foreign +import Foreign import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S import qualified Data.ByteString.Internal as S@@ -41,7 +41,7 @@ main :: IO () main = do- let (chunkInfos, benchmarks) = unzip + let (chunkInfos, benchmarks) = unzip {- [ lazyVsBlaze ( "partitionLazy"@@ -97,7 +97,7 @@ , toLazyByteString . concatMapBuilder (fromReplicateWord8 10) , (\i -> L.pack $ take i $ cycle [0..]) , n `div` 10 )- , lazyVsBlaze + , lazyVsBlaze ( "unfoldr countToZero" , L.unfoldr countToZero , unfoldrBlaze countToZero@@ -118,7 +118,7 @@ ( do putStrLn $ cmpName ++ ": " ++ checkResults showChunksize implLazy lazy showChunksize implBlaze blaze- , bgroup cmpName + , bgroup cmpName [ mkBench implBlaze blaze , mkBench implLazy lazy ]@@ -129,7 +129,7 @@ x = prep n nInfo = "for n = " ++ show n- checkResults + checkResults | lazy x == blaze x = "implementations agree " ++ nInfo | otherwise = unlines [ "ERROR: IMPLEMENTATIONS DISAGREE " ++ nInfo , implLazy ++ ": " ++ show (lazy x)@@ -141,7 +141,7 @@ cs = map S.length $ L.toChunks bs putStrLn $ " " ++ implName ++ ": " putStrLn $ " chunks sizes: " ++ show cs- putStrLn $ " avg. chunk size: " ++ + putStrLn $ " avg. chunk size: " ++ show ((fromIntegral (sum cs) :: Double) / fromIntegral (length cs)) mkBench implName impl = bench implName $ whnf (L.length . impl) x@@ -179,7 +179,7 @@ unfoldrBlaze f x = toLazyByteString $ fromWriteUnfoldr writeWord8 f x fromWriteUnfoldr :: (b -> Write) -> (a -> Maybe (b, a)) -> a -> Builder-fromWriteUnfoldr write = +fromWriteUnfoldr write = makeBuilder where makeBuilder f x0 = fromBuildStepCont $ step x0@@ -195,8 +195,8 @@ | pf `plusPtr` bound <= pe0 = do !pf' <- runWrite (write y) pf go (f x') pf'- | otherwise = return $ bufferFull bound pf $ - \(BufRange pfNew peNew) -> do + | otherwise = return $ bufferFull bound pf $+ \(BufRange pfNew peNew) -> do !pfNew' <- runWrite (write y) pfNew fill x' (BufRange pfNew' peNew) where@@ -207,7 +207,7 @@ ------------------------ test :: Int -> (L.ByteString, L.ByteString)-test i = +test i = ((L.filter ((==0) . (`mod` 3)) $ x) , (filterBlaze ((==0) . (`mod` 3)) $ x)) where@@ -237,12 +237,12 @@ mapLazyByteString f = mapFilterMapLazyByteString f (const True) id {-# INLINE mapLazyByteString #-} -mapFilterMapByteString :: (Word8 -> Word8) -> (Word8 -> Bool) -> (Word8 -> Word8) +mapFilterMapByteString :: (Word8 -> Word8) -> (Word8 -> Bool) -> (Word8 -> Word8) -> S.ByteString -> Builder-mapFilterMapByteString f p g = +mapFilterMapByteString f p g = \bs -> fromBuildStepCont $ step bs where- step (S.PS ifp ioff isize) !k = + step (S.PS ifp ioff isize) !k = goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff) where !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)@@ -250,7 +250,7 @@ | ip0 >= ipe = do touchForeignPtr ifp -- input buffer consumed k br | op0 < ope = goPartial (ip0 `plusPtr` min outRemaining inpRemaining)- | otherwise = return $ bufferFull 1 op0 (goBS ip0) + | otherwise = return $ bufferFull 1 op0 (goBS ip0) where outRemaining = ope `minusPtr` op0 inpRemaining = ipe `minusPtr` ip0@@ -267,9 +267,9 @@ goBS ip (BufRange op ope) {-# INLINE mapFilterMapByteString #-} -mapFilterMapLazyByteString :: (Word8 -> Word8) -> (Word8 -> Bool) -> (Word8 -> Word8) +mapFilterMapLazyByteString :: (Word8 -> Word8) -> (Word8 -> Bool) -> (Word8 -> Word8) -> L.ByteString -> Builder-mapFilterMapLazyByteString f p g = +mapFilterMapLazyByteString f p g = L.foldrChunks (\c b -> mapFilterMapByteString f p g c `mappend` b) mempty {-# INLINE mapFilterMapLazyByteString #-} @@ -295,10 +295,10 @@ -} fromWriteReplicated :: (a -> Write) -> Int -> a -> Builder-fromWriteReplicated write = +fromWriteReplicated write = makeBuilder where- makeBuilder !n0 x = fromBuildStepCont $ step + makeBuilder !n0 x = fromBuildStepCont $ step where bound = getBound $ write x step !k = fill n0@@ -312,15 +312,15 @@ | pf `plusPtr` bound <= pe0 = do pf' <- runWrite (write x) pf go (n-1) pf'- | otherwise = return $ bufferFull bound pf $ - \(BufRange pfNew peNew) -> do + | otherwise = return $ bufferFull bound pf $+ \(BufRange pfNew peNew) -> do pfNew' <- runWrite (write x) pfNew fill (n-1) (BufRange pfNew' peNew) {-# INLINE fromWriteReplicated #-} -- FIXME: Output repeated bytestrings for large replications. fromReplicateWord8 :: Int -> Word8 -> Builder-fromReplicateWord8 !n0 x = +fromReplicateWord8 !n0 x = fromBuildStepCont $ step where step !k = fill n0@@ -380,7 +380,7 @@ intersperseBlaze :: Word8 -- ^ Byte to intersperse. -> L.ByteString -- ^ Lazy 'L.ByteString' to be "spread". -> Builder -- ^ Resulting 'Builder'.-intersperseBlaze w lbs0 = +intersperseBlaze w lbs0 = Builder $ step lbs0 where step lbs1 k = goChunk lbs1@@ -390,21 +390,21 @@ go touch where- go + go where- !pf' = pf `plusPtr` - - + !pf' = pf `plusPtr`++ goChunk !L.Empty !pf = k pf pe0 goChunk !lbs@(L.Chunk bs' lbs') !pf | pf' <= pe0 = do- withForeignPtr fpbuf $ \pbuf -> + withForeignPtr fpbuf $ \pbuf -> copyBytes pf (pbuf `plusPtr` offset) size go lbs' pf' | otherwise = return $ BufferFull size pf (step lbs k) where- !pf' = pf `plusPtr` + !pf' = pf `plusPtr` !(fpbuf, offset, size) = S.toForeignPtr bs' {-# INLINE intersperseBlaze #-} @@ -455,14 +455,14 @@ -------------------------------------------- intersperseBlocks :: Int -> S.ByteString -> S.ByteString -> Builder-intersperseBlocks blockSize sep (S.PS ifp ioff isize) = +intersperseBlocks blockSize sep (S.PS ifp ioff isize) = fromPut $ do- lastBS <- go (ip0 `plusPtr` ioff) + lastBS <- go (ip0 `plusPtr` ioff) unless (S.null lastBS) (putBuilder $ fromByteString lastBS) where ip0 = unsafeForeignPtrToPtr ifp ipe = ip0 `plusPtr` (ioff + isize)- go !ip + go !ip | ip `plusPtr` blockSize >= ipe = return $ S.PS ifp (ip `minusPtr` ip0) (ipe `minusPtr` ip) | otherwise = do@@ -500,15 +500,15 @@ encodeBase64 = encodeLazyBase64 . L.fromChunks . return encodeLazyBase64 :: L.ByteString -> Builder-encodeLazyBase64 = +encodeLazyBase64 = mkBuilder where mkBuilder bs = fromPut $ do- remainder <- putWriteLazyBlocks 3 writeBase64 bs + remainder <- putWriteLazyBlocks 3 writeBase64 bs putBuilder $ complete remainder {-# INLINE writeBase64 #-}- writeBase64 ip = + writeBase64 ip = exactWrite 4 $ \op -> do b0 <- peekByte 0 b1 <- peekByte 1@@ -519,7 +519,7 @@ where peekByte :: Int -> IO Word32 peekByte off = fmap fromIntegral (peekByteOff ip off :: IO Word8)- + enc = peekElemOff (unsafeForeignPtrToPtr encodeTable) . fromIntegral {-# INLINE complete #-}@@ -532,14 +532,14 @@ pad off = pokeByteOff op off (fromIntegral $ ord '=' :: Word8) poke6Base64 0 18 poke6Base64 1 12- if S.length bs == 1 then pad 2 + if S.length bs == 1 then pad 2 else poke6Base64 2 8 pad 3 where getByte :: Int -> Int -> Word32 getByte i sh = fromIntegral (bs `S.unsafeIndex` i) `shiftL` sh w = getByte 0 16 .|. (if S.length bs == 1 then 0 else getByte 1 8)- + -- Lookup table trick from Data.ByteString.Base64 by Bryan O'Sullivan {-# NOINLINE alphabet #-} alphabet :: S.ByteString@@ -547,7 +547,7 @@ -- FIXME: Check that the implementation of the lookup table aslo works on -- big-endian systems.- {-# NOINLINE encodeTable #-} + {-# NOINLINE encodeTable #-} encodeTable :: ForeignPtr Word16 encodeTable = unsafePerformIO $ do fp <- mallocForeignPtrArray 4096@@ -573,23 +573,23 @@ putWriteBlocks blockSize write = \bs -> putBuildStepCont $ step bs where- step (S.PS ifp ioff isize) !k = + step (S.PS ifp ioff isize) !k = goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff) where !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize) goBS !ip0 !br@(BufRange op0 ope)- | ip0 `plusPtr` blockSize > ipe = do + | ip0 `plusPtr` blockSize > ipe = do touchForeignPtr ifp -- input buffer consumed- let !bs' = S.PS ifp (ip0 `minusPtr` unsafeForeignPtrToPtr ifp) + let !bs' = S.PS ifp (ip0 `minusPtr` unsafeForeignPtrToPtr ifp) (ipe `minusPtr` ip0) k bs' br - | op0 `plusPtr` writeBound < ope = + | op0 `plusPtr` writeBound < ope = goPartial (ip0 `plusPtr` (blockSize * min outRemaining inpRemaining)) - | otherwise = return $ bufferFull writeBound op0 (goBS ip0) + | otherwise = return $ bufferFull writeBound op0 (goBS ip0) where- writeBound = getBound' "putWriteBlocks" write + writeBound = getBound' "putWriteBlocks" write outRemaining = (ope `minusPtr` op0) `div` writeBound inpRemaining = (ipe `minusPtr` ip0) `div` blockSize @@ -618,36 +618,36 @@ go (L.Chunk bs lbs) = do bsRem <- putWriteBlocks blockSize write bs case S.length bsRem of- lRem + lRem | lRem <= 0 -> go lbs | otherwise -> do- let (lbsPre, lbsSuf) = + let (lbsPre, lbsSuf) = L.splitAt (fromIntegral $ blockSize - lRem) lbs case S.concat $ bsRem : L.toChunks lbsPre of block@(S.PS bfp boff bsize) | bsize < blockSize -> return block | otherwise -> do- putBuilder $ fromWrite $ + putBuilder $ fromWrite $ write (unsafeForeignPtrToPtr bfp `plusPtr` boff) putLiftIO $ touchForeignPtr bfp- go lbsSuf - + go lbsSuf + ------------------------------------------------------------------------------ -- Testing code ------------------------------------------------------------------------------ chunks3 :: [Word8] -> [Word32]-chunks3 (b0 : b1 : b2 : bs) = - ((fromIntegral b0 `shiftL` 16) .|. - (fromIntegral b1 `shiftL` 8) .|. +chunks3 (b0 : b1 : b2 : bs) =+ ((fromIntegral b0 `shiftL` 16) .|.+ (fromIntegral b1 `shiftL` 8) .|. (fromIntegral b2 ) ) : chunks3 bs chunks3 _ = [] cmpWriteToLib :: [Word8] -> (L.ByteString, L.ByteString)-cmpWriteToLib bs = +cmpWriteToLib bs = -- ( toLazyByteString $ fromWriteList write24bitsBase64 $ chunks3 bs ( toLazyByteString $ encodeBase64 $ S.pack bs , (`L.Chunk` L.empty) $ encode $ S.pack bs )@@ -655,11 +655,11 @@ test3 :: Bool test3 = uncurry (==) $ cmpWriteToLib $ [0..] -test2 :: L.ByteString +test2 :: L.ByteString test2 = toLazyByteString $ encodeBase64 $ S.pack [0..] {- OLD code- + {-# INLINE poke8 #-} poke8 :: Word8 -> Ptr Word8 -> IO () poke8 = flip poke@@ -697,7 +697,7 @@ write6bitsBase64 (w `shiftr_w32` 18) `mappend` write6bitsBase64 (w `shiftr_w32` 12) `mappend` writeIf (const only8) (const $ C8.writeChar '=')- (write6bitsBase64 . (`shiftr_w32` 6)) + (write6bitsBase64 . (`shiftr_w32` 6)) w `mappend` C8.writeChar '=' @@ -711,7 +711,7 @@ -- ASSUMES bits 25 - 31 are zero. {-# INLINE write24bitsBase64' #-} write24bitsBase64' :: Word32 -> Write-write24bitsBase64' w = +write24bitsBase64' w = exactWrite 4 $ \p -> do poke (castPtr p ) =<< enc (w `shiftR` 12) poke (castPtr $ p `plusPtr` 2) =<< enc (w .&. 0xfff)@@ -747,12 +747,12 @@ {-# INLINE partitionStrict #-} partitionStrict :: (Word8 -> Bool) -> S.ByteString -> (S.ByteString, S.ByteString)-partitionStrict f (S.PS ifp ioff ilen) = +partitionStrict f (S.PS ifp ioff ilen) = second S.reverse $ S.inlinePerformIO $ do ofp <- S.mallocByteString ilen withForeignPtr ifp $ wrapper ofp where- wrapper !ofp !ip0 = + wrapper !ofp !ip0 = go (ip0 `plusPtr` ioff) op0 (op0 `plusPtr` ilen) where op0 = unsafeForeignPtrToPtr ofp@@ -761,8 +761,8 @@ | oph == opl = return (S.PS ofp 0 olen, S.PS ofp olen (ilen - olen)) | otherwise = do x <- peek ip- if f x - then do poke opl x + if f x+ then do poke opl x go (ip `plusPtr` 1) (opl `plusPtr` 1) oph else do let oph' = oph `plusPtr` (-1) poke oph' x@@ -773,10 +773,10 @@ {-# INLINE partitionLazy #-} partitionLazy :: (Word8 -> Bool) -> L.ByteString -> (L.ByteString, L.ByteString)-partitionLazy f = +partitionLazy f = L.foldrChunks partitionOne (L.empty, L.empty) where- partitionOne bs (ls, rs) = + partitionOne bs (ls, rs) = (L.Chunk l ls, L.Chunk r rs) where (l, r) = partitionStrict f bs
benchmarks/PlotTest.hs view
@@ -3,9 +3,9 @@ -- Module : PlotTest -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : GHC -- -- Test plotting for the benchmarks.@@ -67,7 +67,7 @@ -- | A pseudo-random stream of 'Word8' always started from the same initial -- seed. randomWord8s :: [Word8]-randomWord8s = map fromIntegral $ unfoldr (Just . R.next) (R.mkStdGen 666) +randomWord8s = map fromIntegral $ unfoldr (Just . R.next) (R.mkStdGen 666) -- Main function ----------------@@ -83,14 +83,14 @@ -- | Run a list of benchmarks; flattening benchmark groups to a path of strings. runFlattenedBenchmarks :: [Benchmark] -> MyCriterion [([String],Sample)]-runFlattenedBenchmarks = +runFlattenedBenchmarks = (concat `liftM`) . mapM (go id) where go path (Benchmark name b) = do env <- ask sample <- lift $ runBenchmark env b return [(path [name], sample)]- go path (BenchGroup name bs) = + go path (BenchGroup name bs) = concat `liftM` mapM (go (path . (name:))) bs -- | Run a benchmark for a series of data points; e.g. to measure scalability@@ -106,9 +106,9 @@ runMyCriterion config criterion = do env <- withConfig config measureEnvironment withConfig config (runReaderT criterion env)- + -- Plotting Infrastructure -------------------------- @@ -116,7 +116,7 @@ colorPalette = [blue, green, red, yellow, magenta, cyan] lineStylePalette :: [CairoLineStyle]-lineStylePalette = +lineStylePalette = map (solidLine 1 . opaque) colorPalette ++ map (dashedLine 1 [5, 5] . opaque) colorPalette @@ -125,7 +125,7 @@ layoutPlot :: PlotData -> Layout1 Int Double layoutPlot ((title, xName, yName), lines) =- layout1_plots ^= map (Right . toPlot) plots $ + layout1_plots ^= map (Right . toPlot) plots $ layout1_title ^= title $ layout1_bottom_axis ^= mkLinearAxis xName $ layout1_right_axis ^= mkLogAxis yName $@@ -136,18 +136,18 @@ -- | Plot a single named line using the given line style. plotLine :: String -> CairoLineStyle -> [(Int,Double)] -> PlotLines Int Double-plotLine name style points = +plotLine name style points = plot_lines_title ^= name $ plot_lines_style ^= style $- plot_lines_values ^= [points] $ + plot_lines_values ^= [points] $ defaultPlotLines mkLinearAxis :: String -> LayoutAxis Int mkLinearAxis name = laxis_title ^= name $ defaultLayoutAxis mkLogAxis :: String -> LayoutAxis Double-mkLogAxis name = - laxis_title ^= name $ +mkLogAxis name =+ laxis_title ^= name $ laxis_generate ^= autoScaledLogAxis defaultLogAxis $ defaultLayoutAxis @@ -169,12 +169,12 @@ plots :: [PlotLines Int Double]-plots = [ plotLine [c] style testData +plots = [ plotLine [c] style testData | (c, style) <- zip ['a'..] (cycle lineStylePalette) ] -mkLayout xname yname title p = - layout1_plots ^= [Right p] $ +mkLayout xname yname title p =+ layout1_plots ^= [Right p] $ layout1_title ^= title $ layout1_bottom_axis ^= mkLinearAxis xname $ layout1_right_axis ^= mkLogAxis yname $@@ -196,19 +196,19 @@ let plottedLines = flip map lines $ \ ((name,lineStyle,_), points) -> plot_lines_title ^= name $ plot_lines_style ^= lineStyle $- plot_lines_values ^= [points] $ + plot_lines_values ^= [points] $ defaultPlotLines- let layout = + let layout = defaultLayout1 { layout1_plots_ = map (Right . toPlot) plottedLines }- renderableToWindow (toRenderable layout) 640 480 + renderableToWindow (toRenderable layout) 640 480 measureSerializer :: (a, [(Int, IO (Maybe Double))]) -> IO (Maybe (a, [(Int,Double)])) measureSerializer (info, tests) = do optPoints <- forM tests $ \ (x, test) -> do optY <- test- case optY of + case optY of Nothing -> return Nothing Just y -> return $ Just (x, y) case catMaybes optPoints of
benchmarks/StrictIO.hs view
@@ -23,6 +23,3 @@ return $ i + 1 {-# INLINE subcases #-} -- -
benchmarks/StringAndText.hs view
@@ -3,16 +3,16 @@ -- Module : StringAndText -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Benchmarking of String and Text serialization. module StringAndText (main) where import Data.Char (ord)-import Data.Monoid +import Data.Monoid import Criterion.Main @@ -25,23 +25,24 @@ import qualified Data.Text.Lazy.Encoding as TL import qualified Blaze.ByteString.Builder as Blaze-import qualified Blaze.ByteString.Builder.Internal as Blaze+import qualified Data.ByteString.Builder.Internal as Blaze+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze import qualified Blaze.ByteString.Builder.Html.Utf8 as Blaze main :: IO ()-main = defaultMain +main = defaultMain [ bench "TL.unpack :: LazyText -> String" $ nf TL.unpack benchLazyText , bench "TL.foldr :: LazyText -> String" $ nf (TL.foldr (:) []) benchLazyText- + , bench "fromString :: String --[Utf8 encoding]--> L.ByteString" $ whnf (L.length . Blaze.toLazyByteString . Blaze.fromString) benchString , bench "fromStrictTextUnpacked :: StrictText --[Utf8 encoding]--> L.ByteString" $ whnf (L.length . Blaze.toLazyByteString . Blaze.fromText) benchStrictText- + -- , bench "fromStrictTextFolded :: StrictText --[Utf8 encoding]--> L.ByteString" $ whnf -- (L.length . Blaze.toLazyByteString . fromStrictTextFolded) benchStrictText @@ -62,10 +63,10 @@ , bench "fromHtmlEscapedStrictTextUnpacked :: StrictText --[HTML esc. & Utf8 encoding]--> L.ByteString" $ whnf (L.length . Blaze.toLazyByteString . Blaze.fromHtmlEscapedText) benchStrictText- + , bench "fromHtmlEscapedLazyTextUnpacked :: LazyText --[HTML esc. & Utf8 encoding]--> L.ByteString" $ whnf (L.length . Blaze.toLazyByteString . Blaze.fromHtmlEscapedLazyText) benchLazyText- + ] n :: Int
benchmarks/Throughput/BinaryBuilder.hs view
@@ -195,7 +195,7 @@ writeWord16N1Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = mempty- loop s n = + loop s n = (putWord16le (s+0)) `mappend` loop (s+1) (n-1)
benchmarks/Throughput/BlazeBuilder.hs view
@@ -11,7 +11,7 @@ import Throughput.Utils serialize :: Int -> Int -> Endian -> Int -> L.ByteString-serialize wordSize chunkSize end = toLazyByteString . +serialize wordSize chunkSize end = toLazyByteString . case (wordSize, chunkSize, end) of (1, 1,_) -> writeByteN1 (1, 2,_) -> writeByteN2@@ -201,7 +201,7 @@ writeWord16N1Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = mempty- loop s n = + loop s n = fromWrite (writeWord16le (s+0)) `mappend` loop (s+1) (n-1)
benchmarks/Throughput/BlazeBuilderDeclarative.hs view
@@ -12,7 +12,7 @@ import Throughput.Utils serialize :: Int -> Int -> Endian -> Int -> L.ByteString-serialize wordSize chunkSize end = toLazyByteString . +serialize wordSize chunkSize end = toLazyByteString . case (wordSize, chunkSize, end) of (1, 1,_) -> writeByteN1 (1, 2,_) -> writeByteN2@@ -193,5 +193,4 @@ writeWord64N4Host = fromWrite4List writeWord64host . word64List writeWord64N8Host = fromWrite8List writeWord64host . word64List writeWord64N16Host = fromWrite16List writeWord64host . word64List-
benchmarks/Throughput/BlazePut.hs view
@@ -2,7 +2,7 @@ module Throughput.BlazePut (serialize) where import qualified Data.ByteString.Lazy as L-import Blaze.ByteString.Builder +import Blaze.ByteString.Builder import Throughput.BlazePutMonad as Put import Data.Monoid @@ -12,7 +12,7 @@ ------------------------------------------------------------------------ serialize :: Int -> Int -> Endian -> Int -> L.ByteString-serialize wordSize chunkSize end = runPut . +serialize wordSize chunkSize end = runPut . case (wordSize, chunkSize, end) of (1, 1,_) -> writeByteN1 (1, 2,_) -> writeByteN2@@ -72,7 +72,7 @@ writeByteN1 bytes = loop 0 0 where loop !s !n | n == bytes = return ()- | otherwise = do + | otherwise = do Put.putWrite ( writeWord8 s) loop (s+1) (n+1) @@ -88,7 +88,7 @@ writeByteN4 = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord8 (s+0) `mappend` writeWord8 (s+1) `mappend`@@ -99,7 +99,7 @@ writeByteN8 = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord8 (s+0) `mappend` writeWord8 (s+1) `mappend`@@ -114,7 +114,7 @@ writeByteN16 = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord8 (s+0) `mappend` writeWord8 (s+1) `mappend`@@ -140,14 +140,14 @@ writeWord16N1Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord16be (s+0) loop (s+1) (n-1) writeWord16N2Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16be (s+0) `mappend` writeWord16be (s+1))@@ -156,7 +156,7 @@ writeWord16N4Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16be (s+0) `mappend` writeWord16be (s+1) `mappend`@@ -167,7 +167,7 @@ writeWord16N8Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16be (s+0) `mappend` writeWord16be (s+1) `mappend`@@ -182,7 +182,7 @@ writeWord16N16Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16be (s+0) `mappend` writeWord16be (s+1) `mappend`@@ -208,14 +208,14 @@ writeWord16N1Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = + loop s n = do Put.putWord16le (s+0) loop (s+1) (n-1) writeWord16N2Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16le (s+0) `mappend` writeWord16le (s+1))@@ -224,7 +224,7 @@ writeWord16N4Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16le (s+0) `mappend` writeWord16le (s+1) `mappend`@@ -235,7 +235,7 @@ writeWord16N8Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16le (s+0) `mappend` writeWord16le (s+1) `mappend`@@ -250,7 +250,7 @@ writeWord16N16Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16le (s+0) `mappend` writeWord16le (s+1) `mappend`@@ -276,14 +276,14 @@ writeWord16N1Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord16host (s+0) loop (s+1) (n-1) writeWord16N2Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16host (s+0) `mappend` writeWord16host (s+1))@@ -292,7 +292,7 @@ writeWord16N4Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16host (s+0) `mappend` writeWord16host (s+1) `mappend`@@ -303,7 +303,7 @@ writeWord16N8Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16host (s+0) `mappend` writeWord16host (s+1) `mappend`@@ -318,7 +318,7 @@ writeWord16N16Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord16host (s+0) `mappend` writeWord16host (s+1) `mappend`@@ -343,14 +343,14 @@ writeWord32N1Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord32be (s+0) loop (s+1) (n-1) writeWord32N2Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32be (s+0) `mappend` writeWord32be (s+1))@@ -359,7 +359,7 @@ writeWord32N4Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32be (s+0) `mappend` writeWord32be (s+1) `mappend`@@ -370,7 +370,7 @@ writeWord32N8Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32be (s+0) `mappend` writeWord32be (s+1) `mappend`@@ -385,7 +385,7 @@ writeWord32N16Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32be (s+0) `mappend` writeWord32be (s+1) `mappend`@@ -410,14 +410,14 @@ writeWord32N1Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord32le (s+0) loop (s+1) (n-1) writeWord32N2Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32le (s+0) `mappend` writeWord32le (s+1))@@ -426,7 +426,7 @@ writeWord32N4Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32le (s+0) `mappend` writeWord32le (s+1) `mappend`@@ -437,7 +437,7 @@ writeWord32N8Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32le (s+0) `mappend` writeWord32le (s+1) `mappend`@@ -452,7 +452,7 @@ writeWord32N16Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32le (s+0) `mappend` writeWord32le (s+1) `mappend`@@ -477,14 +477,14 @@ writeWord32N1Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord32host (s+0) loop (s+1) (n-1) writeWord32N2Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32host (s+0) `mappend` writeWord32host (s+1))@@ -493,7 +493,7 @@ writeWord32N4Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32host (s+0) `mappend` writeWord32host (s+1) `mappend`@@ -504,7 +504,7 @@ writeWord32N8Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32host (s+0) `mappend` writeWord32host (s+1) `mappend`@@ -519,7 +519,7 @@ writeWord32N16Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord32host (s+0) `mappend` writeWord32host (s+1) `mappend`@@ -544,14 +544,14 @@ writeWord64N1Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord64be (s+0) loop (s+1) (n-1) writeWord64N2Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64be (s+0) `mappend` writeWord64be (s+1))@@ -560,7 +560,7 @@ writeWord64N4Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64be (s+0) `mappend` writeWord64be (s+1) `mappend`@@ -571,7 +571,7 @@ writeWord64N8Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64be (s+0) `mappend` writeWord64be (s+1) `mappend`@@ -586,7 +586,7 @@ writeWord64N16Big = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64be (s+0) `mappend` writeWord64be (s+1) `mappend`@@ -611,14 +611,14 @@ writeWord64N1Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord64le (s+0) loop (s+1) (n-1) writeWord64N2Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64le (s+0) `mappend` writeWord64le (s+1))@@ -627,7 +627,7 @@ writeWord64N4Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64le (s+0) `mappend` writeWord64le (s+1) `mappend`@@ -638,7 +638,7 @@ writeWord64N8Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64le (s+0) `mappend` writeWord64le (s+1) `mappend`@@ -653,7 +653,7 @@ writeWord64N16Little = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64le (s+0) `mappend` writeWord64le (s+1) `mappend`@@ -678,14 +678,14 @@ writeWord64N1Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWord64host (s+0) loop (s+1) (n-1) writeWord64N2Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64host (s+0) `mappend` writeWord64host (s+1))@@ -694,7 +694,7 @@ writeWord64N4Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64host (s+0) `mappend` writeWord64host (s+1) `mappend`@@ -705,7 +705,7 @@ writeWord64N8Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64host (s+0) `mappend` writeWord64host (s+1) `mappend`@@ -720,7 +720,7 @@ writeWord64N16Host = loop 0 where loop s n | s `seq` n `seq` False = undefined loop _ 0 = return ()- loop s n = do + loop s n = do Put.putWrite ( writeWord64host (s+0) `mappend` writeWord64host (s+1) `mappend`
benchmarks/Throughput/BlazePutMonad.hs view
@@ -4,7 +4,7 @@ -- Module : Data.Binary.Put -- Copyright : Lennart Kolmodin -- License : BSD3-style (see LICENSE)--- +-- -- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se> -- Stability : stable -- Portability : Portable to Hugs and GHC. Requires MPTCs@@ -64,7 +64,7 @@ ------------------------------------------------------------------------ --- XXX Strict in buffer only. +-- XXX Strict in buffer only. data PairS a = PairS a {-# UNPACK #-}!Builder sndS :: PairS a -> Builder
benchmarks/Throughput/Utils.hs view
@@ -1,5 +1,5 @@ module Throughput.Utils (- Endian(..) + Endian(..) ) where @@ -8,5 +8,4 @@ | Little | Host deriving (Eq,Ord,Show)-
benchmarks/UnboxedAppend.hs view
@@ -3,9 +3,9 @@ -- Module : UnboxedAppend -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Try using unboxed pointers for the continuation calls to make abstract@@ -85,7 +85,7 @@ {-# UNPACK #-} !(Ptr Word8) !(PutStep a) | InsertByteString- {-# UNPACK #-} !(Ptr Word8) + {-# UNPACK #-} !(Ptr Word8) !S.ByteString !(PutStep a) @@ -138,7 +138,7 @@ {-# INLINE unboxBuildStep #-} fromWriteSingleton :: (a -> Write) -> a -> Builder-fromWriteSingleton write = +fromWriteSingleton write = mkBuilder where mkBuilder x = fromBuildStep step@@ -148,7 +148,7 @@ io pf let !br' = BufRange (pf `plusPtr` size) pe callBuildStep k br'- | otherwise = + | otherwise = return $ BufferFull size pf (unboxBuildStep $ step k) where Write size io = write x@@ -175,11 +175,11 @@ return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size) unsafeFreezeBuffer :: Buffer -> S.ByteString-unsafeFreezeBuffer (Buffer fpbuf p0 op _) = +unsafeFreezeBuffer (Buffer fpbuf p0 op _) = S.PS fpbuf 0 (op `minusPtr` p0) unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString-unsafeFreezeNonEmptyBuffer (Buffer fpbuf p0 op _) +unsafeFreezeNonEmptyBuffer (Buffer fpbuf p0 op _) | p0 == op = Nothing | otherwise = Just $ S.PS fpbuf 0 (op `minusPtr` p0) @@ -188,7 +188,7 @@ | ope `minusPtr` op <= minSize = Nothing | otherwise = Just (Buffer fpbuf op op ope) -runPut :: Monad m +runPut :: Monad m => (IO (PutSignal a) -> m (PutSignal a)) -- lifting of buildsteps -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next -> (S.ByteString -> m ()) -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream@@ -203,7 +203,7 @@ runStep step buf@(Buffer fpbuf p0 op ope) = do let !br = BufRange op ope signal <- liftIO $ callBuildStep step br- case signal of + case signal of Done op' x -> -- put completed, buffer partially runSteped return (x, Buffer fpbuf p0 op' ope) @@ -222,7 +222,7 @@ outputBS bs runStep nextStep buf' {-# INLINE runPut #-}- + -- | A monad for lazily composing lazy bytestrings using continuations. newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) } @@ -234,7 +234,7 @@ -- | Execute a put and return the written buffers as the chunks of a lazy -- bytestring. toLazyByteString2 :: Put a -> L.ByteString-toLazyByteString2 put = +toLazyByteString2 put = k (bufToLBSCont (snd result) L.empty) where -- initial buffer
benchmarks/Utf8IO.hs view
@@ -2,9 +2,9 @@ -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)--- --- Maintainer : Simon Meier <iridcode@gmail.com>--- Stability : experimental+--+-- Maintainer : https://github.com/blaze-builder+-- Stability : stable -- Portability : tested on GHC only -- -- Benchmarking IO output speed of writing a string in Utf8 encoding to a file.@@ -25,14 +25,14 @@ import System.IO import System.Environment -import Blaze.ByteString.Builder +import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Internal (defaultBufferSize) import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze -- | Write using the standard text utf8 encoding function built into 'base'. writeUtf8_base :: String -> FilePath -> IO ()-writeUtf8_base cs file = +writeUtf8_base cs file = withFile file WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h cs@@ -72,13 +72,13 @@ -- utf8-light is missing support for lazy bytestrings => test 100 times -- writing a 100 times smaller string to avoid out-of-memory errors.- "utf8-light" -> return $ \f -> sequence_ $ replicate 100 $ + "utf8-light" -> return $ \f -> sequence_ $ replicate 100 $ writeUtf8_light (take (n `div` 100) cs) f "via-text" -> do return $ writeUtf8_text tx -- Here, we ensure that the text tx is already packed before timing.- "text" -> do _ <- evaluate (TL.length tx) + "text" -> do _ <- evaluate (TL.length tx) return $ writeUtf8_text tx _ -> error $ "unknown writer '" ++ how ++ "'" t <- timed_ $ writer file@@ -99,4 +99,3 @@ -- | Execute an IO action and return the time it took to execute it. timed_ :: IO a -> IO NominalDiffTime timed_ = (snd `liftM`) . timed-
blaze-builder.cabal view
@@ -1,40 +1,60 @@+Cabal-version: 1.18 Name: blaze-builder-Version: 0.3.3.4+Version: 0.4.4.1 Synopsis: Efficient buffered output. -Description: - This library provides an abstraction of buffered output of- byte streams and several convenience functions to exploit- it. For example, it allows to efficiently serialize- Haskell values to lazy bytestrings with a large average- chunk size. The large average chunk size allows to make- good use of cache prefetching in later processing steps- (e.g. compression) and reduces the system call overhead- when writing the resulting lazy bytestring to a file or- sending it over the network.+Description:+ This library allows to efficiently serialize Haskell values to lazy bytestrings+ with a large average chunk size. The large average chunk size allows to make+ good use of cache prefetching in later processing steps (e.g. compression) and+ reduces the system call overhead when writing the resulting lazy bytestring to a+ file or sending it over the network.+ .+ This library was inspired by the module Data.Binary.Builder 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. -Author: Jasper Van der Jeugt, Simon Meier-Copyright: 2010-2014 Simon Meier- 2010 Jasper Van der Jeugt-Maintainer: Simon Meier <iridcode@gmail.com>+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: https://github.com/blaze-builder License: BSD3 License-file: LICENSE -Homepage: http://github.com/meiersi/blaze-builder-Bug-Reports: http://github.com/meiersi/blaze-builder/issues-Stability: Experimental+Homepage: https://github.com/blaze-builder/blaze-builder+Bug-Reports: https://github.com/blaze-builder/blaze-builder/issues+Stability: Stable Category: Data Build-type: Simple-Cabal-version: >= 1.6 -Extra-source-files: - Makefile+Tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2++Extra-doc-files: README.markdown- TODO- CHANGES+ CHANGELOG.md +Extra-source-files:+ Makefile+ benchmarks/*.hs benchmarks/Throughput/*.hs benchmarks/Throughput/*.h@@ -44,18 +64,10 @@ Source-repository head Type: git- Location: https://github.com/meiersi/blaze-builder.git+ Location: https://github.com/blaze-builder/blaze-builder.git Library- ghc-options: -Wall-- -- Earlier versions of GHC did not split off unsafe functions in "Foreign"- if impl(ghc >= 7.4)- cpp-options: -DHAS_FOREIGN_UNSAFE_MODULE-- -- GHC 7.0.x and lower required MonoPatBinds feature- if impl(ghc < 7.2)- cpp-options: -DUSE_MONO_PAT_BINDS+ default-language: Haskell98 exposed-modules: Blaze.ByteString.Builder Blaze.ByteString.Builder.Int@@ -64,15 +76,38 @@ Blaze.ByteString.Builder.Char.Utf8 Blaze.ByteString.Builder.Char8 Blaze.ByteString.Builder.Html.Utf8+ Blaze.ByteString.Builder.Html.Word Blaze.ByteString.Builder.HTTP+ Blaze.ByteString.Builder.Compat.Write - Blaze.ByteString.Builder.Internal Blaze.ByteString.Builder.Internal.Write- Blaze.ByteString.Builder.Internal.Types- Blaze.ByteString.Builder.Internal.Buffer - other-modules: Blaze.ByteString.Builder.Internal.UncheckedShifts- - build-depends: base == 4.* ,- bytestring >= 0.9 && < 1.0 ,- text >= 0.10 && < 1.3+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.10.4 && < 1+ , text >= 1.1.2 && < 3++ ghc-options:+ -Wall+ -Wcompat++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Tests.hs+ default-language: Haskell98+ ghc-options:+ -Wall+ -Wno-orphans+ -Wcompat++ build-depends: base+ , blaze-builder+ , bytestring+ , HUnit+ , QuickCheck+ , test-framework+ , test-framework-hunit+ , test-framework-quickcheck2+ , text+ , utf8-string
tests/Tests.hs view
@@ -1,10 +1,10 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}+ -- | Tests for the Blaze builder ---{-# LANGUAGE OverloadedStrings #-}-module Tests where--import Control.Applicative ((<$>))-import Data.Monoid (mempty, mappend, mconcat)+module Main where import qualified Data.Text as T import qualified Data.ByteString.Lazy as LB@@ -79,8 +79,10 @@ escaping3 :: Assertion escaping3 = fromString ""'" @?= fromHtmlEscapedString "\"'" +#if !MIN_VERSION_bytestring(0,11,1) instance Show Builder where show = show . toLazyByteString+#endif instance Show Write where show = show . fromWrite@@ -102,7 +104,7 @@ instance Arbitrary Write where arbitrary = mconcat . map singleWrite <$> arbitrary where- singleWrite (Left bs) = writeByteString (LB.toStrict bs)+ singleWrite (Left bs) = writeByteString (mconcat (LB.toChunks bs)) singleWrite (Right w) = writeWord8 w instance Arbitrary LB.ByteString where