diff --git a/Blaze/ByteString/Builder.hs b/Blaze/ByteString/Builder.hs --- a/Blaze/ByteString/Builder.hs +++ b/Blaze/ByteString/Builder.hs @@ -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 --- 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 #-} diff --git a/Blaze/ByteString/Builder/ByteString.hs b/Blaze/ByteString/Builder/ByteString.hs --- a/Blaze/ByteString/Builder/ByteString.hs +++ b/Blaze/ByteString/Builder/ByteString.hs @@ -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 --- 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 #-} - diff --git a/Blaze/ByteString/Builder/Char/Utf8.hs b/Blaze/ByteString/Builder/Char/Utf8.hs --- a/Blaze/ByteString/Builder/Char/Utf8.hs +++ b/Blaze/ByteString/Builder/Char/Utf8.hs @@ -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 --- 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 #-} diff --git a/Blaze/ByteString/Builder/Char8.hs b/Blaze/ByteString/Builder/Char8.hs --- a/Blaze/ByteString/Builder/Char8.hs +++ b/Blaze/ByteString/Builder/Char8.hs @@ -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 --- 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 #-} diff --git a/Blaze/ByteString/Builder/Compat/Write.hs b/Blaze/ByteString/Builder/Compat/Write.hs new file mode 100644 --- /dev/null +++ b/Blaze/ByteString/Builder/Compat/Write.hs @@ -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 #-} diff --git a/Blaze/ByteString/Builder/HTTP.hs b/Blaze/ByteString/Builder/HTTP.hs --- a/Blaze/ByteString/Builder/HTTP.hs +++ b/Blaze/ByteString/Builder/HTTP.hs @@ -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" - - diff --git a/Blaze/ByteString/Builder/Html/Utf8.hs b/Blaze/ByteString/Builder/Html/Utf8.hs --- a/Blaze/ByteString/Builder/Html/Utf8.hs +++ b/Blaze/ByteString/Builder/Html/Utf8.hs @@ -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 --- 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 diff --git a/Blaze/ByteString/Builder/Html/Word.hs b/Blaze/ByteString/Builder/Html/Word.hs new file mode 100644 --- /dev/null +++ b/Blaze/ByteString/Builder/Html/Word.hs @@ -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 diff --git a/Blaze/ByteString/Builder/Int.hs b/Blaze/ByteString/Builder/Int.hs --- a/Blaze/ByteString/Builder/Int.hs +++ b/Blaze/ByteString/Builder/Int.hs @@ -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 --- 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 #-} diff --git a/Blaze/ByteString/Builder/Internal.hs b/Blaze/ByteString/Builder/Internal.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal.hs +++ /dev/null @@ -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 --- 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 - ] - --} - --} diff --git a/Blaze/ByteString/Builder/Internal/Buffer.hs b/Blaze/ByteString/Builder/Internal/Buffer.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/Buffer.hs +++ /dev/null @@ -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 --- 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' diff --git a/Blaze/ByteString/Builder/Internal/Types.hs b/Blaze/ByteString/Builder/Internal/Types.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/Types.hs +++ /dev/null @@ -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 --- 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) diff --git a/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs b/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs +++ /dev/null @@ -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 --- 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 - diff --git a/Blaze/ByteString/Builder/Internal/Write.hs b/Blaze/ByteString/Builder/Internal/Write.hs --- a/Blaze/ByteString/Builder/Internal/Write.hs +++ b/Blaze/ByteString/Builder/Internal/Write.hs @@ -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 --- 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 diff --git a/Blaze/ByteString/Builder/Word.hs b/Blaze/ByteString/Builder/Word.hs --- a/Blaze/ByteString/Builder/Word.hs +++ b/Blaze/ByteString/Builder/Word.hs @@ -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 --- 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 #-} diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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: + + + + - The 'Blaze.ByteString.Builder.Html.Utf8.fromHtmlEscaped*' functions now + strip out any ASCII control characters present in their inputs. See + 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. diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -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. diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 ############################################################################## diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,3 +1,8 @@ +[![Hackage version](https://img.shields.io/hackage/v/blaze-builder.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/blaze-builder) +[![blaze-builder on Stackage Nightly](https://stackage.org/package/blaze-builder/badge/nightly)](https://stackage.org/nightly/package/blaze-builder) +[![Stackage LTS version](https://www.stackage.org/package/blaze-builder/badge/lts?label=Stackage)](https://www.stackage.org/package/blaze-builder) +[![Cabal build](https://github.com/blaze-builder/blaze-builder/workflows/Haskell-CI/badge.svg)](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. diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -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 'fromWriteList' - (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 diff --git a/benchmarks/BenchThroughput.hs b/benchmarks/BenchThroughput.hs --- a/benchmarks/BenchThroughput.hs +++ b/benchmarks/BenchThroughput.hs @@ -3,9 +3,9 @@ -- Module : BenchThroughput -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 - diff --git a/benchmarks/BenchmarkServer.hs b/benchmarks/BenchmarkServer.hs --- a/benchmarks/BenchmarkServer.hs +++ b/benchmarks/BenchmarkServer.hs @@ -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 diff --git a/benchmarks/BlazeVsBinary.hs b/benchmarks/BlazeVsBinary.hs --- a/benchmarks/BlazeVsBinary.hs +++ b/benchmarks/BlazeVsBinary.hs @@ -3,9 +3,9 @@ -- Module : BlazeVsBinary -- Copyright : (c) 2010 Jasper Van der Jeught & Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/BoundedWrite.hs b/benchmarks/BoundedWrite.hs --- a/benchmarks/BoundedWrite.hs +++ b/benchmarks/BoundedWrite.hs @@ -3,9 +3,9 @@ -- Module : BoundedWrite -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 #-} - diff --git a/benchmarks/BuilderBufferRange.hs b/benchmarks/BuilderBufferRange.hs --- a/benchmarks/BuilderBufferRange.hs +++ b/benchmarks/BuilderBufferRange.hs @@ -3,9 +3,9 @@ -- Module : BuilderBufferRange -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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) diff --git a/benchmarks/ChunkedWrite.hs b/benchmarks/ChunkedWrite.hs --- a/benchmarks/ChunkedWrite.hs +++ b/benchmarks/ChunkedWrite.hs @@ -3,9 +3,9 @@ -- Module : ChunkedWrite -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 - diff --git a/benchmarks/Compression.hs b/benchmarks/Compression.hs --- a/benchmarks/Compression.hs +++ b/benchmarks/Compression.hs @@ -2,9 +2,9 @@ -- Module : Compression -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/FastPut.hs b/benchmarks/FastPut.hs --- a/benchmarks/FastPut.hs +++ b/benchmarks/FastPut.hs @@ -3,9 +3,9 @@ -- Module : FastPut -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 ] - diff --git a/benchmarks/LazyByteString.hs b/benchmarks/LazyByteString.hs --- a/benchmarks/LazyByteString.hs +++ b/benchmarks/LazyByteString.hs @@ -3,9 +3,9 @@ -- Module : LazyByteString -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/PlotTest.hs b/benchmarks/PlotTest.hs --- a/benchmarks/PlotTest.hs +++ b/benchmarks/PlotTest.hs @@ -3,9 +3,9 @@ -- Module : PlotTest -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/StrictIO.hs b/benchmarks/StrictIO.hs --- a/benchmarks/StrictIO.hs +++ b/benchmarks/StrictIO.hs @@ -23,6 +23,3 @@ return $ i + 1 {-# INLINE subcases #-} - - - diff --git a/benchmarks/StringAndText.hs b/benchmarks/StringAndText.hs --- a/benchmarks/StringAndText.hs +++ b/benchmarks/StringAndText.hs @@ -3,16 +3,16 @@ -- Module : StringAndText -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/Throughput/BinaryBuilder.hs b/benchmarks/Throughput/BinaryBuilder.hs --- a/benchmarks/Throughput/BinaryBuilder.hs +++ b/benchmarks/Throughput/BinaryBuilder.hs @@ -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) diff --git a/benchmarks/Throughput/BlazeBuilder.hs b/benchmarks/Throughput/BlazeBuilder.hs --- a/benchmarks/Throughput/BlazeBuilder.hs +++ b/benchmarks/Throughput/BlazeBuilder.hs @@ -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) diff --git a/benchmarks/Throughput/BlazeBuilderDeclarative.hs b/benchmarks/Throughput/BlazeBuilderDeclarative.hs --- a/benchmarks/Throughput/BlazeBuilderDeclarative.hs +++ b/benchmarks/Throughput/BlazeBuilderDeclarative.hs @@ -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 - diff --git a/benchmarks/Throughput/BlazePut.hs b/benchmarks/Throughput/BlazePut.hs --- a/benchmarks/Throughput/BlazePut.hs +++ b/benchmarks/Throughput/BlazePut.hs @@ -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` diff --git a/benchmarks/Throughput/BlazePutMonad.hs b/benchmarks/Throughput/BlazePutMonad.hs --- a/benchmarks/Throughput/BlazePutMonad.hs +++ b/benchmarks/Throughput/BlazePutMonad.hs @@ -4,7 +4,7 @@ -- Module : Data.Binary.Put -- Copyright : Lennart Kolmodin -- License : BSD3-style (see LICENSE) --- +-- -- Maintainer : Lennart Kolmodin -- 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 diff --git a/benchmarks/Throughput/Utils.hs b/benchmarks/Throughput/Utils.hs --- a/benchmarks/Throughput/Utils.hs +++ b/benchmarks/Throughput/Utils.hs @@ -1,5 +1,5 @@ module Throughput.Utils ( - Endian(..) + Endian(..) ) where @@ -8,5 +8,4 @@ | Little | Host deriving (Eq,Ord,Show) - diff --git a/benchmarks/UnboxedAppend.hs b/benchmarks/UnboxedAppend.hs --- a/benchmarks/UnboxedAppend.hs +++ b/benchmarks/UnboxedAppend.hs @@ -3,9 +3,9 @@ -- Module : UnboxedAppend -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 diff --git a/benchmarks/Utf8IO.hs b/benchmarks/Utf8IO.hs --- a/benchmarks/Utf8IO.hs +++ b/benchmarks/Utf8IO.hs @@ -2,9 +2,9 @@ -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- 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 - diff --git a/blaze-builder.cabal b/blaze-builder.cabal --- a/blaze-builder.cabal +++ b/blaze-builder.cabal @@ -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 +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 diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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