packages feed

blaze-builder 0.3.3.4 → 0.4.0.0

raw patch · 28 files changed

+733/−1750 lines, 28 filesdep +HUnitdep +QuickCheckdep +blaze-builderdep ~basedep ~bytestringdep ~textnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, QuickCheck, blaze-builder, bytestring-builder, deepseq, test-framework, test-framework-hunit, test-framework-quickcheck2, utf8-string

Dependency ranges changed: base, bytestring, text

API changes (from Hackage documentation)

- Blaze.ByteString.Builder.Internal: BufRange :: {-# UNPACK #-} !(Ptr Word8) -> {-# UNPACK #-} !(Ptr Word8) -> BufRange
- Blaze.ByteString.Builder.Internal: bufferFull :: Int -> Ptr Word8 -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a
- Blaze.ByteString.Builder.Internal: data BufRange
- Blaze.ByteString.Builder.Internal: data BuildSignal a
- Blaze.ByteString.Builder.Internal: data BuildStep a
- Blaze.ByteString.Builder.Internal: data Builder
- Blaze.ByteString.Builder.Internal: data Put a
- Blaze.ByteString.Builder.Internal: defaultBufferSize :: Int
- Blaze.ByteString.Builder.Internal: defaultFirstBufferSize :: Int
- Blaze.ByteString.Builder.Internal: defaultMaximalCopySize :: Int
- Blaze.ByteString.Builder.Internal: defaultMinimalBufferSize :: Int
- Blaze.ByteString.Builder.Internal: done :: Ptr Word8 -> a -> BuildSignal a
- Blaze.ByteString.Builder.Internal: flush :: Builder
- Blaze.ByteString.Builder.Internal: fromBuildStepCont :: (forall r. (BufRange -> IO (BuildSignal r)) -> (BufRange -> IO (BuildSignal r))) -> Builder
- Blaze.ByteString.Builder.Internal: fromPut :: Put a -> Builder
- Blaze.ByteString.Builder.Internal: insertByteString :: Ptr Word8 -> ByteString -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a
- Blaze.ByteString.Builder.Internal: putBuildStepCont :: (forall r. (a -> BufRange -> IO (BuildSignal r)) -> (BufRange -> IO (BuildSignal r))) -> Put a
- Blaze.ByteString.Builder.Internal: putBuilder :: Builder -> Put ()
- Blaze.ByteString.Builder.Internal: putLiftIO :: IO a -> Put a
- Blaze.ByteString.Builder.Internal: toByteString :: Builder -> ByteString
- Blaze.ByteString.Builder.Internal: toByteStringIO :: (ByteString -> IO ()) -> Builder -> IO ()
- Blaze.ByteString.Builder.Internal: toByteStringIOWith :: Int -> (ByteString -> IO ()) -> Builder -> IO ()
- Blaze.ByteString.Builder.Internal: toLazyByteString :: Builder -> ByteString
- Blaze.ByteString.Builder.Internal: toLazyByteStringWith :: Int -> Int -> Int -> Builder -> ByteString -> ByteString
- Blaze.ByteString.Builder.Internal: writeToByteString :: Write -> ByteString
- Blaze.ByteString.Builder.Internal.Buffer: Buffer :: {-# UNPACK #-} !(ForeignPtr Word8) -> {-# UNPACK #-} !(Ptr Word8) -> {-# UNPACK #-} !(Ptr Word8) -> {-# UNPACK #-} !(Ptr Word8) -> Buffer
- Blaze.ByteString.Builder.Internal.Buffer: allNewBuffersStrategy :: Int -> BufferAllocStrategy
- Blaze.ByteString.Builder.Internal.Buffer: allocBuffer :: Int -> IO Buffer
- Blaze.ByteString.Builder.Internal.Buffer: bufferSize :: Buffer -> Int
- Blaze.ByteString.Builder.Internal.Buffer: data Buffer
- Blaze.ByteString.Builder.Internal.Buffer: execBuildStep :: BuildStep a -> Buffer -> IO (BuildSignal a)
- Blaze.ByteString.Builder.Internal.Buffer: freeSize :: Buffer -> Int
- Blaze.ByteString.Builder.Internal.Buffer: nextSlice :: Int -> Buffer -> Maybe Buffer
- Blaze.ByteString.Builder.Internal.Buffer: reuseBuffer :: Buffer -> Buffer
- Blaze.ByteString.Builder.Internal.Buffer: reuseBufferStrategy :: IO Buffer -> BufferAllocStrategy
- Blaze.ByteString.Builder.Internal.Buffer: runPut :: Monad m => (IO (BuildSignal a) -> m (BuildSignal a)) -> (Int -> Buffer -> m Buffer) -> (ByteString -> m ()) -> Put a -> Buffer -> m (a, Buffer)
- Blaze.ByteString.Builder.Internal.Buffer: sliceSize :: Buffer -> Int
- Blaze.ByteString.Builder.Internal.Buffer: type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))
- Blaze.ByteString.Builder.Internal.Buffer: unsafeFreezeBuffer :: Buffer -> ByteString
- Blaze.ByteString.Builder.Internal.Buffer: unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe ByteString
- Blaze.ByteString.Builder.Internal.Buffer: updateEndOfSlice :: Buffer -> Ptr Word8 -> Buffer
- Blaze.ByteString.Builder.Internal.Types: BufRange :: {-# UNPACK #-} !(Ptr Word8) -> {-# UNPACK #-} !(Ptr Word8) -> BufRange
- Blaze.ByteString.Builder.Internal.Types: BufferFull :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !(Ptr Word8) -> !(BuildStep a) -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: BuildStep :: (BufRange -> IO (BuildSignal a)) -> BuildStep a
- Blaze.ByteString.Builder.Internal.Types: Builder :: (forall r. BuildStep r -> BuildStep r) -> Builder
- Blaze.ByteString.Builder.Internal.Types: Done :: {-# UNPACK #-} !(Ptr Word8) -> a -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: InsertByteString :: {-# UNPACK #-} !(Ptr Word8) -> !ByteString -> !(BuildStep a) -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: Put :: (forall r. (a -> BuildStep r) -> BuildStep r) -> Put a
- Blaze.ByteString.Builder.Internal.Types: bufferFull :: Int -> Ptr Word8 -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: buildStep :: (BufRange -> IO (BuildSignal a)) -> BuildStep a
- Blaze.ByteString.Builder.Internal.Types: data BufRange
- Blaze.ByteString.Builder.Internal.Types: data BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: done :: Ptr Word8 -> a -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: fromBuildStepCont :: (forall r. (BufRange -> IO (BuildSignal r)) -> (BufRange -> IO (BuildSignal r))) -> Builder
- Blaze.ByteString.Builder.Internal.Types: fromPut :: Put a -> Builder
- Blaze.ByteString.Builder.Internal.Types: insertByteString :: Ptr Word8 -> ByteString -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a
- Blaze.ByteString.Builder.Internal.Types: instance Applicative Put
- Blaze.ByteString.Builder.Internal.Types: instance Functor Put
- Blaze.ByteString.Builder.Internal.Types: instance Monad Put
- Blaze.ByteString.Builder.Internal.Types: instance Monoid Builder
- Blaze.ByteString.Builder.Internal.Types: newtype BuildStep a
- Blaze.ByteString.Builder.Internal.Types: newtype Builder
- Blaze.ByteString.Builder.Internal.Types: newtype Put a
- Blaze.ByteString.Builder.Internal.Types: putBuildStepCont :: (forall r. (a -> BufRange -> IO (BuildSignal r)) -> (BufRange -> IO (BuildSignal r))) -> Put a
- Blaze.ByteString.Builder.Internal.Types: putBuilder :: Builder -> Put ()
- Blaze.ByteString.Builder.Internal.Types: putLiftIO :: IO a -> Put a
- Blaze.ByteString.Builder.Internal.Types: runBuildStep :: BuildStep a -> BufRange -> IO (BuildSignal a)
- Blaze.ByteString.Builder.Internal.Types: unBuilder :: Builder -> forall r. BuildStep r -> BuildStep r
- Blaze.ByteString.Builder.Internal.Types: unPut :: Put a -> forall r. (a -> BuildStep r) -> BuildStep r
- Blaze.ByteString.Builder.Internal.Write: data Poke
+ Blaze.ByteString.Builder.Compat.Write: data Write
+ Blaze.ByteString.Builder.Compat.Write: writePrimBounded :: BoundedPrim a -> a -> Write
+ Blaze.ByteString.Builder.Compat.Write: writePrimFixed :: FixedPrim a -> a -> Write
+ Blaze.ByteString.Builder.Internal.Write: Poke :: (Ptr Word8 -> IO (Ptr Word8)) -> Poke
+ Blaze.ByteString.Builder.Internal.Write: Write :: {-# UNPACK #-} !Int -> Poke -> Write
+ Blaze.ByteString.Builder.Internal.Write: newtype Poke
- Blaze.ByteString.Builder: data Builder
+ Blaze.ByteString.Builder: data Builder :: *

Files

Blaze/ByteString/Builder.hs view
@@ -1,12 +1,13 @@------------------------------------------------------------------------------+{-# LANGUAGE CPP, BangPatterns          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder--- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- "Blaze.ByteString.Builder" is the main module, which you should import as a user -- of the @blaze-builder@ library.@@ -54,42 +55,204 @@ -- 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) +#if __GLASGOW_HASKELL__ >= 702+import Foreign+import qualified Foreign.ForeignPtr.Unsafe as Unsafe+#else+import Foreign as Unsafe+#endif++import qualified Blaze.ByteString.Builder.Internal.Write as W+import           Blaze.ByteString.Builder.ByteString+import           Blaze.ByteString.Builder.Word+import           Blaze.ByteString.Builder.Int++import           Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder       as B+import qualified Data.ByteString.Builder.Extra as B++import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy          as L+import qualified Data.ByteString.Lazy.Internal as L++#if __GLASGOW_HASKELL__ >= 702+import System.IO.Unsafe (unsafeDupablePerformIO)+#else+unsafeDupablePerformIO :: IO a -> a+unsafeDupablePerformIO = unsafePerformIO+#endif++++-- | Pack the chunks of a lazy bytestring into a single strict bytestring.+packChunks :: L.ByteString -> S.ByteString+packChunks lbs = do+    S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)+  where+    copyChunks !L.Empty                         !_pf = return ()+    copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf  = do+        withForeignPtr fpbuf $ \pbuf ->+            copyBytes pf (pbuf `plusPtr` o) l+        copyChunks lbs' (pf `plusPtr` l)++-- | Run the builder to construct a strict bytestring containing the sequence+-- of bytes denoted by the builder. This is done by first serializing to a lazy bytestring and then packing its+-- chunks to a appropriately sized strict bytestring.+--+-- > toByteString = packChunks . toLazyByteString+--+-- Note that @'toByteString'@ is a 'Monoid' homomorphism.+--+-- > toByteString mempty          == mempty+-- > toByteString (x `mappend` y) == toByteString x `mappend` toByteString y+--+-- However, in the second equation, the left-hand-side is generally faster to+-- execute.+--+toByteString :: Builder -> S.ByteString+toByteString = packChunks . B.toLazyByteString++-- | Default size (~32kb) for the buffer that becomes a chunk of the output+-- stream once it is filled.+--+defaultBufferSize :: Int+defaultBufferSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy.+    where overhead = 2 * sizeOf (undefined :: Int)+++-- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of+-- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the+-- buffer is full.+--+-- Compared to 'toLazyByteStringWith' this function requires less allocation,+-- as the output buffer is only allocated once at the start of the+-- serialization and whenever something bigger than the current buffer size has+-- to be copied into the buffer, which should happen very seldomly for the+-- default buffer size of 32kb. Hence, the pressure on the garbage collector is+-- reduced, which can be an advantage when building long sequences of bytes.+--+toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO ()+toByteStringIO = toByteStringIOWith defaultBufferSize++toByteStringIOWith :: Int                      -- ^ Buffer size (upper bounds+                                               -- the number of bytes forced+                                               -- per call to the 'IO' action).+                   -> (S.ByteString -> IO ())  -- ^ 'IO' action to execute per+                                               -- full buffer, which is+                                               -- referenced by a strict+                                               -- 'S.ByteString'.+                   -> Builder                -- ^ 'Builder' to run.+                   -> IO ()                    -- ^ Resulting 'IO' action.+toByteStringIOWith !bufSize io builder = do+    S.mallocByteString bufSize >>= getBuffer (B.runBuilder builder) bufSize+  where+    getBuffer writer !size fp = do+      let !ptr = Unsafe.unsafeForeignPtrToPtr fp+      (bytes, next) <- writer ptr size+      case next of+        B.Done -> io $! S.PS fp 0 bytes+        B.More req writer' -> do+           io $! S.PS fp 0 bytes+           let !size' = max bufSize req+           S.mallocByteString size' >>= getBuffer writer' size'+        B.Chunk bs' writer' -> do+           if bytes > 0+             then do+               io $! S.PS fp 0 bytes+               unless (S.null bs') (io bs')+               S.mallocByteString bufSize >>= getBuffer writer' bufSize+             else do+               unless (S.null bs') (io bs')+               getBuffer writer' size fp+++-- | Run a 'Builder' with the given buffer sizes.+--+-- Use this function for integrating the 'Builder' type with other libraries+-- that generate lazy bytestrings.+--+-- Note that the builders should guarantee that on average the desired chunk+-- size is attained. Builders may decide to start a new buffer and not+-- completely fill the existing buffer, if this is faster. However, they should+-- not spill too much of the buffer, if they cannot compensate for it.+--+-- FIXME: Note that the following paragraphs are not entirely correct as of+-- blaze-builder-0.4:+--+-- A call @toLazyByteStringWith bufSize minBufSize firstBufSize@ will generate+-- a lazy bytestring according to the following strategy. First, we allocate+-- a buffer of size @firstBufSize@ and start filling it. If it overflows, we+-- allocate a buffer of size @minBufSize@ and copy the first buffer to it in+-- order to avoid generating a too small chunk. Finally, every next buffer will+-- be of size @bufSize@. This, slow startup strategy is required to achieve+-- good speed for short (<200 bytes) resulting bytestrings, as for them the+-- allocation cost is of a large buffer cannot be compensated. Moreover, this+-- strategy also allows us to avoid spilling too much memory for short+-- resulting bytestrings.+--+-- Note that setting @firstBufSize >= minBufSize@ implies that the first buffer+-- is no longer copied but allocated and filled directly. Hence, setting+-- @firstBufSize = bufSize@ means that all chunks will use an underlying buffer+-- of size @bufSize@. This is recommended, if you know that you always output+-- more than @minBufSize@ bytes.+toLazyByteStringWith+    :: Int           -- ^ Buffer size (upper-bounds the resulting chunk size).+    -> Int           -- ^ This parameter is ignored as of blaze-builder-0.4+    -> Int           -- ^ Size of the first buffer to be used and copied for+                     -- larger resulting sequences+    -> Builder       -- ^ Builder to run.+    -> L.ByteString  -- ^ Lazy bytestring to output after the builder is+                     -- finished.+    -> L.ByteString  -- ^ Resulting lazy bytestring+toLazyByteStringWith bufSize _minBufSize firstBufSize builder k =+    B.toLazyByteStringWith (B.safeStrategy firstBufSize bufSize) k builder++-- | Run a 'Write' to produce a strict 'S.ByteString'.+-- This is equivalent to @('toByteString' . 'fromWrite')@, but is more+-- efficient because it uses just one appropriately-sized buffer.+writeToByteString :: W.Write -> S.ByteString+writeToByteString !w = unsafeDupablePerformIO $ do+    fptr <- S.mallocByteString (W.getBound w)+    len <- withForeignPtr fptr $ \ptr -> do+        end <- W.runWrite w ptr+        return $! end `minusPtr` ptr+    return $! S.fromForeignPtr fptr 0 len+{-# INLINE writeToByteString #-}
Blaze/ByteString/Builder/ByteString.hs view
@@ -1,21 +1,12 @@-{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-+------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.ByteString--- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.ByteString+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental ----- '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 treshold, and inserts it directly otherwise. ----- These rules guarantee that average chunk size in the output stream is at--- least half the @maximalCopySize@.+-- For example, @fromByteStringWith 1024@ copies strict 'S.ByteString's whose size+-- is less or equal to 1kb, and inserts them directly otherwise. This implies+-- that the average chunk-size of the generated lazy 'L.ByteString' may be as+-- low as 513 bytes, as there could always be just a single byte between the+-- directly inserted 1025 byte, strict 'S.ByteString's. -- fromByteStringWith :: Int          -- ^ Maximal number of bytes to copy.                    -> S.ByteString -- ^ Strict 'S.ByteString' to serialize.-                   -> Builder      -- ^ Resulting 'Builder'.-fromByteStringWith maxCopySize =-    \bs -> fromBuildStepCont $ step bs-  where-    step !bs !k br@(BufRange !op _)-      | maxCopySize < S.length bs = return $ I.insertByteString op bs k-      | otherwise                 = copyByteStringStep bs k br+                   -> B.Builder    -- ^ Resulting 'B.Builder'.+fromByteStringWith = B.byteStringThreshold {-# INLINE fromByteStringWith #-} --- | @copyByteString bs@ serialize the strict bytestring @bs@ by copying it to--- the output buffer.+-- | Construct a 'B.Builder' that copies the strict 'S.ByteString'. ----- Use this function to serialize strict bytestrings that are statically known--- to be smallish (@<= 4kb@).+-- Use this function to create 'B.Builder's from smallish (@<= 4kb@)+-- 'S.ByteString's or if you need to guarantee that the 'S.ByteString' is not+-- shared with the chunks generated by the 'B.Builder'. ---copyByteString :: S.ByteString -> Builder-copyByteString = \bs -> fromBuildStepCont $ copyByteStringStep bs+copyByteString :: S.ByteString -> B.Builder+copyByteString = B.byteStringCopy {-# INLINE copyByteString #-} -copyByteStringStep :: S.ByteString-                   -> (BufRange -> IO (BuildSignal a))-                   -> (BufRange -> IO (BuildSignal a))-copyByteStringStep (S.PS ifp ioff isize) !k =-    goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff)-  where-    !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)-    goBS !ip !(BufRange op ope)-      | inpRemaining <= outRemaining = do-          copyBytes op ip inpRemaining-          touchForeignPtr ifp -- input consumed: OK to release from here-          let !br' = BufRange (op `plusPtr` inpRemaining) ope-          k br'-      | otherwise = do-          copyBytes op ip outRemaining-          let !ip' = ip `plusPtr` outRemaining-          return $ bufferFull 1 ope (goBS ip')-      where-        outRemaining = ope `minusPtr` op-        inpRemaining = ipe `minusPtr` ip-{-# INLINE copyByteStringStep #-}---- | @insertByteString bs@ serializes the strict bytestring @bs@ by inserting--- it directly as a chunk of the output stream.+-- | Construct a 'B.Builder' that always inserts the strict 'S.ByteString'+-- directly as a chunk. ----- Note that this implies flushing the output buffer; even if it contains just--- a single byte. Hence, you should use this operation only for large (@> 8kb@)--- bytestrings, as otherwise the resulting output stream may be too fragmented--- to be processed efficiently.+-- This implies flushing the output buffer, even if it contains just+-- a single byte. You should therefore use 'insertByteString' only for large+-- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too+-- fragmented to be processed efficiently afterwards. ---insertByteString :: S.ByteString -> Builder-insertByteString =-    \bs -> fromBuildStepCont $ step bs-  where-    step !bs !k !(BufRange op _) = return $ I.insertByteString op bs k+insertByteString :: S.ByteString -> B.Builder+insertByteString = B.byteStringInsert {-# INLINE insertByteString #-} ---- Lazy bytestrings----------------------------------------------------------------------------------- | /O(n)/. Smart serialization of a lazy bytestring.------ @'fromLazyByteString' = 'fromLazyByteStringWith' 'defaultMaximalCopySize'@------ Use this function to serialize lazy bytestrings. It guarantees an average--- chunk size of 4kb, which has been shown to be a reasonable size in--- benchmarks. Note that the check whether to copy or to insert is (almost)--- free as the builder performance is mostly memory-bound.------ If you statically know that copying or inserting /all/ chunks of the lazy--- bytestring is always the best choice, then you can use the--- 'copyLazyByteString' or 'insertLazyByteString' functions.+-- | Create a 'B.Builder' denoting the same sequence of bytes as a lazy+-- 'S.ByteString'.+-- The 'B.Builder' inserts large chunks of the lazy 'L.ByteString' directly,+-- but copies small ones to ensure that the generated chunks are large on+-- average. ---fromLazyByteString :: L.ByteString -> Builder-fromLazyByteString = fromLazyByteStringWith defaultMaximalCopySize+fromLazyByteString :: L.ByteString -> B.Builder+fromLazyByteString = B.lazyByteString {-# INLINE fromLazyByteString #-} --- | /O(n)/. Serialize a lazy bytestring chunk-wise according to the same rules--- as in 'fromByteStringWith'.------ Semantically, it holds that------ >   fromLazyByteStringWith maxCopySize--- > = mconcat . map (fromByteStringWith maxCopySize) . L.toChunks------ However, the left-hand-side is much more efficient, as it moves the--- end-of-buffer pointer out of the inner loop and provides the compiler with--- more strictness information.+-- | Construct a 'B.Builder' that uses the thresholding strategy of 'fromByteStringWith'+-- for each chunk of the lazy 'L.ByteString'. ---fromLazyByteStringWith :: Int          -- ^ Maximal number of bytes to copy.-                       -> L.ByteString -- ^ Lazy 'L.ByteString' to serialize.-                       -> Builder      -- ^ Resulting 'Builder'.-fromLazyByteStringWith maxCopySize =-  L.foldrChunks (\bs b -> fromByteStringWith maxCopySize bs `mappend` b) mempty+fromLazyByteStringWith :: Int -> L.ByteString -> B.Builder+fromLazyByteStringWith = B.lazyByteStringThreshold {-# INLINE fromLazyByteStringWith #-} ---- | /O(n)/. Serialize a lazy bytestring by copying /all/ chunks sequentially--- to the output buffer.------ See 'copyByteString' for usage considerations.+-- | Construct a 'B.Builder' that copies the lazy 'L.ByteString'. ---copyLazyByteString :: L.ByteString -> Builder-copyLazyByteString =-  L.foldrChunks (\bs b -> copyByteString bs `mappend` b) mempty+copyLazyByteString :: L.ByteString -> B.Builder+copyLazyByteString = B.lazyByteStringCopy {-# INLINE copyLazyByteString #-} --- | /O(n)/. Serialize a lazy bytestring by inserting /all/ its chunks directly--- into the output stream.------ See 'insertByteString' for usage considerations.------ For library developers, see the 'ModifyChunks' build signal, if you--- need an /O(1)/ lazy bytestring insert based on difference lists.+-- | Construct a 'B.Builder' that inserts all chunks of the lazy 'L.ByteString'+-- directly. ---insertLazyByteString :: L.ByteString -> Builder-insertLazyByteString =-  L.foldrChunks (\bs b -> insertByteString bs `mappend` b) mempty+insertLazyByteString :: L.ByteString -> B.Builder+insertLazyByteString = B.lazyByteStringInsert {-# INLINE insertLazyByteString #-}-
Blaze/ByteString/Builder/Char/Utf8.hs view
@@ -1,18 +1,16 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- ignore warning from 'import Data.Text.Encoding'-+------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.Char.Utf8--- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.Char.Utf8+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- '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,95 +24,43 @@     , 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.Lazy as TL  -- | 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 {-# INLINE fromText #-}-  -- | /O(n)/. Serialize a lazy Unicode 'TL.Text' value using the UTF-8 encoding. --
Blaze/ByteString/Builder/Char8.hs view
@@ -1,20 +1,10 @@--- ignore warning from 'import Data.Text.Encoding'-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.Char8--- Copyright   : (c) 2010 Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.Char8+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- //Note:// This package is intended for low-level use like implementing -- protocols. If you need to //serialize// Unicode characters use one of the@@ -25,6 +15,8 @@ -- This corresponds to what the 'bytestring' package offer in -- 'Data.ByteString.Char8'. --+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.Char8     (       -- * Writing Latin-1 (ISO 8859-1) encodable characters to a buffer@@ -38,47 +30,40 @@     , fromLazyText     ) where -import Foreign-import Data.Char (ord)--import qualified Data.Text               as TS-import qualified Data.Text.Encoding      as TS -- imported for documentation links-import qualified Data.Text.Lazy          as TL-import qualified Data.Text.Lazy.Encoding as TS -- imported for documentation links--import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Word+import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )+import           Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.Text      as TS+import qualified Data.Text.Lazy as TL  -- | Write the lower 8-bits of a character to a buffer.----{-# INLINE writeChar #-} writeChar :: Char -> Write-writeChar = writeWord8 . fromIntegral . ord+writeChar = writePrimFixed P.char8+{-# INLINE writeChar #-}  -- | /O(1)/. Serialize the lower 8-bits of a character.--- fromChar :: Char -> Builder-fromChar = fromWriteSingleton writeChar+fromChar = B.char8+{-# INLINE fromChar #-}  -- | /O(n)/. Serialize the lower 8-bits of all characters of a string--- fromString :: String -> Builder-fromString = fromWriteList writeChar+fromString = P.primMapListFixed P.char8+{-# INLINE fromString #-}  -- | /O(n)/. Serialize a value by 'Show'ing it and serializing the lower 8-bits -- of the resulting string.--- fromShow :: Show a => a -> Builder fromShow = fromString . show+{-# INLINE fromShow #-}  -- | /O(n)/. Serialize the lower 8-bits of all characters in the strict text.----{-# INLINE fromText #-} fromText :: TS.Text -> Builder fromText = fromString . TS.unpack+{-# INLINE fromText #-}  -- | /O(n)/. Serialize the lower 8-bits of all characters in the lazy text.----{-# INLINE fromLazyText #-} fromLazyText :: TL.Text -> Builder fromLazyText = fromString . TL.unpack+{-# INLINE fromLazyText #-}
+ Blaze/ByteString/Builder/Compat/Write.hs view
@@ -0,0 +1,29 @@+------------------------------------------------------------------------------+-- |+-- Module:      Blaze.ByteString.Builder.Compat.Write+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental+--+-- Conversions from the new Prims to the old Writes.+--+------------------------------------------------------------------------------++module Blaze.ByteString.Builder.Compat.Write+    ( Write+    , writePrimFixed+    , writePrimBounded+    ) where++import Foreign+import Data.ByteString.Builder.Prim.Internal+import Blaze.ByteString.Builder.Internal.Write++writePrimFixed :: FixedPrim a -> a -> Write+writePrimFixed fe a = exactWrite (size fe) (runF fe a)+{-# INLINE writePrimFixed #-}++writePrimBounded :: BoundedPrim a -> a -> Write+writePrimBounded be a = boundedWrite (sizeBound be) (Poke (runB be a))+{-# INLINE writePrimBounded #-}
Blaze/ByteString/Builder/HTTP.hs view
@@ -1,37 +1,57 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- | Support for HTTP response encoding.+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, MonoPatBinds #-}+------------------------------------------------------------------------------+-- |+-- Module:      Blaze.ByteString.Builder.HTTP+-- Copyright:   (c) 2013 Simon Meier+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental ----- TODO: Improve documentation.+-- Support for HTTP response encoding.+--+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.HTTP (   -- * Chunked HTTP transfer encoding     chunkedTransferEncoding   , chunkedTransferTerminator   ) where +#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word (Word32(..))+#else+import Data.Word+#endif++import Foreign+ import Data.Monoid import qualified Data.ByteString       as S import Data.ByteString.Char8 () -import Foreign--import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Internal.Types-import Blaze.ByteString.Builder.Internal.UncheckedShifts+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__)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)+#else+shiftr_w32 = shiftR+#endif++ -- | Write a CRLF sequence. writeCRLF :: Write writeCRLF = Char8.writeChar '\r' `mappend` Char8.writeChar '\n'@@ -49,28 +69,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))@@ -105,43 +103,25 @@     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+              let !brInner@(BufferRange opInner _) = BufferRange                      (op  `plusPtr` (chunkSizeLength + 2))     -- leave space for chunk header                      (ope `plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data @@ -160,41 +140,38 @@                         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'--                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@@ -220,5 +197,3 @@ -- | The zero-length chunk '0\r\n\r\n' signaling the termination of the data transfer. chunkedTransferTerminator :: Builder chunkedTransferTerminator = copyByteString "0\r\n\r\n"--
Blaze/ByteString/Builder/Html/Utf8.hs view
@@ -1,12 +1,15 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}+#endif++------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.Html.Utf8--- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.Html.Utf8+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- 'Write's and 'Builder's for serializing HTML escaped and UTF-8 encoded -- characters.@@ -15,6 +18,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@@ -35,52 +41,69 @@ import qualified Data.Text      as TS import qualified Data.Text.Lazy as TL -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  -- | 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 "&lt;"-    io '>'  = getPoke $ writeByteString "&gt;"-    io '&'  = getPoke $ writeByteString "&amp;"-    io '"'  = getPoke $ writeByteString "&quot;"-    io '\'' = getPoke $ writeByteString "&#39;"-    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',';')))) $        -- &lt;+    condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $        -- &gt;+    condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $  -- &amp;+    condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $  -- &#quot;+    condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $  -- &#39;+    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 :: TS.Text -> B.Builder fromHtmlEscapedText = fromHtmlEscapedString . TS.unpack  -- | /O(n)/. Serialize a HTML escaped Unicode 'TL.Text' using the UTF-8 encoding. ---fromHtmlEscapedLazyText :: TL.Text -> Builder+fromHtmlEscapedLazyText :: TL.Text -> B.Builder fromHtmlEscapedLazyText = fromHtmlEscapedString . TL.unpack-
Blaze/ByteString/Builder/Int.hs view
@@ -1,24 +1,18 @@-{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.Int--- Copyright   : (c) 2010 Simon Meier------ License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.Int+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- 'Write's and 'Builder's for serializing integers. -- -- See "Blaze.ByteString.Builder.Word" for information about how to best write several -- integers at once. --+------------------------------------------------------------------------------+ module Blaze.ByteString.Builder.Int     (     -- * Writing integers to a buffer@@ -79,60 +73,48 @@      ) where -import Blaze.ByteString.Builder.Internal-import Blaze.ByteString.Builder.Word--import Foreign----------------------------------------------------------------------------------- Int writes--------------------- we rely on 'fromIntegral' to do a loss-less conversion to the corresponding--- 'Word' type-----------------------------------------------------------------------------------+import Data.Int+import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )+import Data.ByteString.Builder ( Builder )+import qualified Data.ByteString.Builder       as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString.Builder.Prim  as P  -- | Write a single signed byte. ---writeInt8 :: Int8 -> Write-writeInt8 = writeWord8 . fromIntegral+writeInt8      :: Int8 -> Write+writeInt8 = writePrimFixed P.int8 {-# INLINE writeInt8 #-}  -- | Write an 'Int16' in big endian format.-writeInt16be :: Int16 -> Write-writeInt16be = writeWord16be . fromIntegral+writeInt16be   :: Int16 -> Write+writeInt16be = writePrimFixed P.int16BE {-# INLINE writeInt16be #-} --- | Write an 'Int16' in little endian format.-writeInt16le :: Int16 -> Write-writeInt16le = writeWord16le . fromIntegral-{-# INLINE writeInt16le #-}- -- | Write an 'Int32' in big endian format.-writeInt32be :: Int32 -> Write-writeInt32be = writeWord32be . fromIntegral+writeInt32be   :: Int32 -> Write+writeInt32be = writePrimFixed P.int32BE {-# INLINE writeInt32be #-} --- | Write an 'Int32' in little endian format.-writeInt32le :: Int32 -> Write-writeInt32le = writeWord32le . fromIntegral-{-# INLINE writeInt32le #-}- -- | Write an 'Int64' in big endian format.-writeInt64be :: Int64 -> Write-writeInt64be = writeWord64be . fromIntegral+writeInt64be   :: Int64 -> Write+writeInt64be = writePrimFixed P.int64BE {-# INLINE writeInt64be #-} --- | Write an 'Int64' in little endian format.-writeInt64le :: Int64 -> Write-writeInt64le = writeWord64le . fromIntegral-{-# INLINE writeInt64le #-}+-- | Write an 'Int16' in little endian format.+writeInt16le   :: Int16 -> Write+writeInt16le = writePrimFixed P.int16LE+{-# INLINE writeInt16le #-} +-- | Write an 'Int32' in little endian format.+writeInt32le   :: Int32 -> Write+writeInt32le = writePrimFixed P.int32LE+{-# INLINE writeInt32le #-} ---------------------------------------------------------------------------- Unaligned, integer size ops+-- | Write an 'Int64' in little endian format.+writeInt64le   :: Int64 -> Write+writeInt64le = writePrimFixed P.int64LE+{-# INLINE writeInt64le #-}  -- | Write a single native machine 'Int'. The 'Int' is written in host order, -- host endian form, for the machine you're on. On a 64 bit machine the 'Int'@@ -140,114 +122,94 @@ -- are not portable to different endian or integer sized machines, without -- conversion. ---writeInthost :: Int -> Write-writeInthost = writeStorable+writeInthost   :: Int -> Write+writeInthost = writePrimFixed P.intHost {-# INLINE writeInthost #-}  -- | Write an 'Int16' in native host order and host endianness. writeInt16host :: Int16 -> Write-writeInt16host = writeStorable+writeInt16host = writePrimFixed P.int16Host {-# INLINE writeInt16host #-}  -- | Write an 'Int32' in native host order and host endianness. writeInt32host :: Int32 -> Write-writeInt32host = writeStorable+writeInt32host = writePrimFixed P.int32Host {-# INLINE writeInt32host #-}  -- | Write an 'Int64' in native host order and host endianness. writeInt64host :: Int64 -> Write-writeInt64host = writeStorable+writeInt64host = writePrimFixed P.int64Host {-# INLINE writeInt64host #-} ----------------------------------------------------------------------------------- Builders corresponding to the integer writes----------------------------------------------------------------------------------- Single bytes-------------------------------------------------------------------------------- -- | Serialize a single byte.----fromInt8 :: Int8 -> Builder-fromInt8 = fromWriteSingleton writeInt8+fromInt8       :: Int8    -> Builder+fromInt8 = B.int8+{-# INLINE fromInt8 #-}  -- | Serialize a list of bytes.----fromInt8s :: [Int8] -> Builder-fromInt8s = fromWriteList writeInt8----- Int16-------------------------------------------------------------------------------+fromInt8s      :: [Int8]  -> Builder+fromInt8s = P.primMapListFixed P.int8+{-# INLINE fromInt8s #-}  -- | Serialize an 'Int16' in big endian format.-fromInt16be :: Int16 -> Builder-fromInt16be = fromWriteSingleton writeInt16be+fromInt16be    :: Int16   -> Builder+fromInt16be = B.int16BE {-# INLINE fromInt16be #-} --- | Serialize a list of 'Int16's in big endian format.-fromInt16sbe :: [Int16] -> Builder-fromInt16sbe = fromWriteList writeInt16be-{-# INLINE fromInt16sbe #-}---- | Serialize an 'Int16' in little endian format.-fromInt16le :: Int16 -> Builder-fromInt16le = fromWriteSingleton writeInt16le-{-# INLINE fromInt16le #-}---- | Serialize a list of 'Int16's in little endian format.-fromInt16sle :: [Int16] -> Builder-fromInt16sle = fromWriteList writeInt16le-{-# INLINE fromInt16sle #-}----- Int32------------------------------------------------------------------------------- -- | Serialize an 'Int32' in big endian format.-fromInt32be :: Int32 -> Builder-fromInt32be = fromWriteSingleton writeInt32be+fromInt32be    :: Int32   -> Builder+fromInt32be = B.int32BE {-# INLINE fromInt32be #-} +-- | Serialize an 'Int64' in big endian format.+fromInt64be    :: Int64   -> Builder+fromInt64be = B.int64BE+{-# INLINE fromInt64be #-}+ -- | Serialize a list of 'Int32's in big endian format.-fromInt32sbe :: [Int32] -> Builder-fromInt32sbe = fromWriteList writeInt32be+fromInt32sbe   :: [Int32] -> Builder+fromInt32sbe = P.primMapListFixed P.int32BE {-# INLINE fromInt32sbe #-} --- | Serialize an 'Int32' in little endian format.-fromInt32le :: Int32 -> Builder-fromInt32le = fromWriteSingleton writeInt32le-{-# INLINE fromInt32le #-}---- | Serialize a list of 'Int32's in little endian format.-fromInt32sle :: [Int32] -> Builder-fromInt32sle = fromWriteList writeInt32le-{-# INLINE fromInt32sle #-}---- | Serialize an 'Int64' in big endian format.-fromInt64be :: Int64 -> Builder-fromInt64be = fromWriteSingleton writeInt64be-{-# INLINE fromInt64be #-}+-- | Serialize a list of 'Int16's in big endian format.+fromInt16sbe   :: [Int16] -> Builder+fromInt16sbe = P.primMapListFixed P.int16BE+{-# INLINE fromInt16sbe #-}  -- | Serialize a list of 'Int64's in big endian format.-fromInt64sbe :: [Int64] -> Builder-fromInt64sbe = fromWriteList writeInt64be+fromInt64sbe   :: [Int64] -> Builder+fromInt64sbe = P.primMapListFixed P.int64BE {-# INLINE fromInt64sbe #-} +-- | Serialize an 'Int16' in little endian format.+fromInt16le    :: Int16   -> Builder+fromInt16le = B.int16LE+{-# INLINE fromInt16le #-}++-- | Serialize an 'Int32' in little endian format.+fromInt32le    :: Int32   -> Builder+fromInt32le = B.int32LE+{-# INLINE fromInt32le #-}+ -- | Serialize an 'Int64' in little endian format.-fromInt64le :: Int64 -> Builder-fromInt64le = fromWriteSingleton writeInt64le+fromInt64le    :: Int64   -> Builder+fromInt64le = B.int64LE {-# INLINE fromInt64le #-} --- | Serialize a list of 'Int64's in little endian format.-fromInt64sle :: [Int64] -> Builder-fromInt64sle = fromWriteList writeInt64le-{-# INLINE fromInt64sle #-}+-- | Serialize a list of 'Int16's in little endian format.+fromInt16sle   :: [Int16] -> Builder+fromInt16sle = P.primMapListFixed P.int16LE+{-# INLINE fromInt16sle #-} +-- | Serialize a list of 'Int32's in little endian format.+fromInt32sle   :: [Int32] -> Builder+fromInt32sle = P.primMapListFixed P.int32LE+{-# INLINE fromInt32sle #-} ---------------------------------------------------------------------------- Unaligned, integer size ops+-- | Serialize a list of 'Int64's in little endian format.+fromInt64sle   :: [Int64] -> Builder+fromInt64sle = P.primMapListFixed P.int64LE+{-# INLINE fromInt64sle #-}  -- | Serialize a single native machine 'Int'. The 'Int' is serialized in host -- order, host endian form, for the machine you're on. On a 64 bit machine the@@ -255,42 +217,42 @@ -- way are not portable to different endian or integer sized machines, without -- conversion. ---fromInthost :: Int -> Builder-fromInthost = fromWriteSingleton writeInthost+fromInthost    :: Int     -> Builder+fromInthost = B.intHost {-# INLINE fromInthost #-} +-- | Write an 'Int16' in native host order and host endianness.+fromInt16host  :: Int16   -> Builder+fromInt16host = B.int16Host+{-# INLINE fromInt16host #-}++-- | Write an 'Int32' in native host order and host endianness.+fromInt32host  :: Int32   -> Builder+fromInt32host = B.int32Host+{-# INLINE fromInt32host #-}++-- | Write an 'Int64' in native host order and host endianness.+fromInt64host  :: Int64   -> Builder+fromInt64host = B.int64Host+{-# INLINE fromInt64host #-}+ -- | Serialize a list of 'Int's. -- See 'fromInthost' for usage considerations.-fromIntshost :: [Int] -> Builder-fromIntshost = fromWriteList writeInthost+fromIntshost   :: [Int]   -> Builder+fromIntshost = P.primMapListFixed P.intHost {-# INLINE fromIntshost #-} --- | Write an 'Int16' in native host order and host endianness.-fromInt16host :: Int16 -> Builder-fromInt16host = fromWriteSingleton writeInt16host-{-# INLINE fromInt16host #-}- -- | Write a list of 'Int16's in native host order and host endianness. fromInt16shost :: [Int16] -> Builder-fromInt16shost = fromWriteList writeInt16host+fromInt16shost = P.primMapListFixed P.int16Host {-# INLINE fromInt16shost #-} --- | Write an 'Int32' in native host order and host endianness.-fromInt32host :: Int32 -> Builder-fromInt32host = fromWriteSingleton writeInt32host-{-# INLINE fromInt32host #-}- -- | Write a list of 'Int32's in native host order and host endianness. fromInt32shost :: [Int32] -> Builder-fromInt32shost = fromWriteList writeInt32host+fromInt32shost = P.primMapListFixed P.int32Host {-# INLINE fromInt32shost #-} --- | Write an 'Int64' in native host order and host endianness.-fromInt64host :: Int64 -> Builder-fromInt64host = fromWriteSingleton writeInt64host-{-# INLINE fromInt64host #-}- -- | Write a list of 'Int64's in native host order and host endianness. fromInt64shost :: [Int64] -> Builder-fromInt64shost = fromWriteList writeInt64host+fromInt64shost = P.primMapListFixed P.int64Host {-# INLINE fromInt64shost #-}
− Blaze/ByteString/Builder/Internal.hs
@@ -1,446 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module      : Blaze.ByteString.Builder.Internal--- Copyright   : (c) 2010 Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only------ Core types and functions for the 'Builder' monoid and the 'Put' monad.----module Blaze.ByteString.Builder.Internal (--  -- * Build Steps-    BufRange(..)-  , BuildSignal-  , BuildStep-  , done-  , bufferFull-  , insertByteString--  -- * Builder-  , Builder-  , fromBuildStepCont-  , fromPut-  , flush--  -- * Put-  , Put-  , putBuilder-  , putBuildStepCont-  , putLiftIO--  -- * Writes-  , module Blaze.ByteString.Builder.Internal.Write-  , writeToByteString--  -- * Execution-  , toLazyByteString-  , toLazyByteStringWith-  , toByteString-  , toByteStringIO-  , toByteStringIOWith--  -- * Deafult Sizes-  , defaultFirstBufferSize-  , defaultMinimalBufferSize-  , defaultBufferSize-  , defaultMaximalCopySize-) where--#ifdef HAS_FOREIGN_UNSAFE_MODULE-import Foreign                   (withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#else-import Foreign                   (unsafeForeignPtrToPtr, withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)-#endif--import Control.Monad (unless)-#if MIN_VERSION_base(4,4,0)-import System.IO.Unsafe (unsafeDupablePerformIO)-#else-import System.IO.Unsafe (unsafePerformIO)-#endif--import qualified Data.ByteString               as S-import qualified Data.ByteString.Internal      as S-import qualified Data.ByteString.Lazy          as L-import qualified Data.ByteString.Lazy.Internal as L--import Blaze.ByteString.Builder.Internal.Types-import Blaze.ByteString.Builder.Internal.Write----------------------------------------------------------------------------------- Internal global constants.----------------------------------------------------------------------------------- | Default size (~32kb) for the buffer that becomes a chunk of the output--- stream once it is filled.----defaultBufferSize :: Int-defaultBufferSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy.-    where overhead = 2 * sizeOf (undefined :: Int)---- | The minimal length (~4kb) a buffer must have before filling it and--- outputting it as a chunk of the output stream.------ This size determines when a buffer is spilled after a 'flush' or a direct--- bytestring insertion. It is also the size of the first chunk generated by--- 'toLazyByteString'.-defaultMinimalBufferSize :: Int-defaultMinimalBufferSize = 4 * 1024 - overhead-    where overhead = 2 * sizeOf (undefined :: Int)---- | The default length (64) for the first buffer to be allocated when--- converting a 'Builder' to a lazy bytestring.------ See 'toLazyByteStringWith' for further explanation.-defaultFirstBufferSize :: Int-defaultFirstBufferSize = 64---- | The maximal number of bytes for that copying is cheaper than direct--- insertion into the output stream. This takes into account the fragmentation--- that may occur in the output buffer due to the early 'flush' implied by the--- direct bytestring insertion.------ @'defaultMaximalCopySize' = 2 * 'defaultMinimalBufferSize'@----defaultMaximalCopySize :: Int-defaultMaximalCopySize = 2 * defaultMinimalBufferSize----------------------------------------------------------------------------------- Flushing and running a Builder----------------------------------------------------------------------------------- | Prepend the chunk if it is non-empty.-{-# INLINE nonEmptyChunk #-}-nonEmptyChunk :: S.ByteString -> L.ByteString -> L.ByteString-nonEmptyChunk bs lbs | S.null bs = lbs-                     | otherwise = L.Chunk bs lbs----- | Output all data written in the current buffer and start a new chunk.------ The use of this function depends on how the resulting bytestrings are--- consumed. 'flush' is possibly not very useful in non-interactive scenarios.--- However, it is kept for compatibility with the builder provided by--- Data.Binary.Builder.------ When using 'toLazyByteString' to extract a lazy 'L.ByteString' from a--- 'Builder', this means that a new chunk will be started in the resulting lazy--- 'L.ByteString'. The remaining part of the buffer is spilled, if the--- reamining free space is smaller than the minimal desired buffer size.----{-# INLINE flush #-}-flush :: Builder-flush = fromBuildStepCont step-  where-    step k !(BufRange op _) = return $ insertByteString op S.empty k---- | Run a 'Builder' with the given buffer sizes.------ Use this function for integrating the 'Builder' type with other libraries--- that generate lazy bytestrings.------ Note that the builders should guarantee that on average the desired chunk--- size is attained. Builders may decide to start a new buffer and not--- completely fill the existing buffer, if this is faster. However, they should--- not spill too much of the buffer, if they cannot compensate for it.------ A call @toLazyByteStringWith bufSize minBufSize firstBufSize@ will generate--- a lazy bytestring according to the following strategy. First, we allocate--- a buffer of size @firstBufSize@ and start filling it. If it overflows, we--- allocate a buffer of size @minBufSize@ and copy the first buffer to it in--- order to avoid generating a too small chunk. Finally, every next buffer will--- be of size @bufSize@. This, slow startup strategy is required to achieve--- good speed for short (<200 bytes) resulting bytestrings, as for them the--- allocation cost is of a large buffer cannot be compensated. Moreover, this--- strategy also allows us to avoid spilling too much memory for short--- resulting bytestrings.------ Note that setting @firstBufSize >= minBufSize@ implies that the first buffer--- is no longer copied but allocated and filled directly. Hence, setting--- @firstBufSize = bufSize@ means that all chunks will use an underlying buffer--- of size @bufSize@. This is recommended, if you know that you always output--- more than @minBufSize@ bytes.-toLazyByteStringWith-    :: Int           -- ^ Buffer size (upper-bounds the resulting chunk size).-    -> Int           -- ^ Minimal free buffer space for continuing filling-                     -- the same buffer after a 'flush' or a direct bytestring-                     -- insertion. This corresponds to the minimal desired-                     -- chunk size.-    -> Int           -- ^ Size of the first buffer to be used and copied for-                     -- larger resulting sequences-    -> Builder       -- ^ Builder to run.-    -> L.ByteString  -- ^ Lazy bytestring to output after the builder is-                     -- finished.-    -> L.ByteString  -- ^ Resulting lazy bytestring-toLazyByteStringWith bufSize minBufSize firstBufSize (Builder b) k =-    S.inlinePerformIO $ fillFirstBuffer (b (buildStep finalStep))-  where-    finalStep (BufRange pf _) = return $ Done pf ()-    -- fill a first very small buffer, if we need more space then copy it-    -- to the new buffer of size 'minBufSize'. This way we don't pay the-    -- allocation cost of the big 'bufSize' buffer, when outputting only-    -- small sequences.-    fillFirstBuffer !step0-      | minBufSize <= firstBufSize = fillNewBuffer firstBufSize step0-      | otherwise                  = do-          fpbuf <- S.mallocByteString firstBufSize-          withForeignPtr fpbuf $ \pf -> do-              let !pe      = pf `plusPtr` firstBufSize-                  mkbs pf' = S.PS fpbuf 0 (pf' `minusPtr` pf)-                  {-# INLINE mkbs #-}-              next <- runBuildStep step0 (BufRange pf pe)-              case next of-                  Done pf' _-                    | pf' == pf -> return k-                    | otherwise -> return $ L.Chunk (mkbs pf') k--                  BufferFull newSize pf' nextStep  -> do-                      let !l  = pf' `minusPtr` pf-                      fillNewBuffer (max (l + newSize) minBufSize) $ buildStep $-                          \(BufRange pfNew peNew) -> do-                              copyBytes pfNew pf l-                              let !br' = BufRange (pfNew `plusPtr` l) peNew-                              runBuildStep nextStep br'--                  InsertByteString pf' bs nextStep-                      | pf' == pf ->-                          return $ nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep)-                      | otherwise ->-                          return $ L.Chunk (mkbs pf')-                              (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))--    -- allocate and fill a new buffer-    fillNewBuffer !size !step0 = do-        fpbuf <- S.mallocByteString size-        withForeignPtr fpbuf $ fillBuffer fpbuf-      where-        fillBuffer fpbuf !pbuf = fill pbuf step0-          where-            !pe = pbuf `plusPtr` size-            fill !pf !step = do-                next <- runBuildStep step (BufRange pf pe)-                let mkbs pf' = S.PS fpbuf (pf `minusPtr` pbuf) (pf' `minusPtr` pf)-                    {-# INLINE mkbs #-}-                case next of-                    Done pf' _-                      | pf' == pf -> return k-                      | otherwise -> return $ L.Chunk (mkbs pf') k--                    BufferFull newSize pf' nextStep-                      | pf' == pf ->-                          fillNewBuffer (max newSize bufSize) nextStep-                      | otherwise ->-                          return $ L.Chunk (mkbs pf')-                              (S.inlinePerformIO $-                                  fillNewBuffer (max newSize bufSize) nextStep)--                    InsertByteString  pf' bs nextStep-                      | pf' == pf                      ->-                          return $ nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep)-                      | minBufSize < pe `minusPtr` pf' ->-                          return $ L.Chunk (mkbs pf')-                              (nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep))-                      | otherwise                      ->-                          return $ L.Chunk (mkbs pf')-                              (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))----- | Extract the lazy 'L.ByteString' from the builder by running it with default--- buffer sizes. Use this function, if you do not have any special--- considerations with respect to buffer sizes.------ @ 'toLazyByteString' b = 'toLazyByteStringWith' 'defaultBufferSize' 'defaultMinimalBufferSize' 'defaultFirstBufferSize' b L.empty@------ Note that @'toLazyByteString'@ is a 'Monoid' homomorphism.------ > toLazyByteString mempty          == mempty--- > toLazyByteString (x `mappend` y) == toLazyByteString x `mappend` toLazyByteString y------ However, in the second equation, the left-hand-side is generally faster to--- execute.----toLazyByteString :: Builder -> L.ByteString-toLazyByteString b = toLazyByteStringWith-    defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty-{-# INLINE toLazyByteString #-}---- | Pack the chunks of a lazy bytestring into a single strict bytestring.-packChunks :: L.ByteString -> S.ByteString-packChunks lbs = do-    S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)-  where-    copyChunks !L.Empty                         !_pf = return ()-    copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf  = do-        withForeignPtr fpbuf $ \pbuf ->-            copyBytes pf (pbuf `plusPtr` o) l-        copyChunks lbs' (pf `plusPtr` l)---- | Run the builder to construct a strict bytestring containing the sequence--- of bytes denoted by the builder. This is done by first serializing to a lazy bytestring and then packing its--- chunks to a appropriately sized strict bytestring.------ > toByteString = packChunks . toLazyByteString------ Note that @'toByteString'@ is a 'Monoid' homomorphism.------ > toByteString mempty          == mempty--- > toByteString (x `mappend` y) == toByteString x `mappend` toByteString y------ However, in the second equation, the left-hand-side is generally faster to--- execute.----toByteString :: Builder -> S.ByteString-toByteString = packChunks . toLazyByteString----- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of--- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the--- buffer is full.------ Compared to 'toLazyByteStringWith' this function requires less allocation,--- as the output buffer is only allocated once at the start of the--- serialization and whenever something bigger than the current buffer size has--- to be copied into the buffer, which should happen very seldomly for the--- default buffer size of 32kb. Hence, the pressure on the garbage collector is--- reduced, which can be an advantage when building long sequences of bytes.----toByteStringIOWith :: Int                      -- ^ Buffer size (upper bounds-                                               -- the number of bytes forced-                                               -- per call to the 'IO' action).-                   -> (S.ByteString -> IO ())  -- ^ 'IO' action to execute per-                                               -- full buffer, which is-                                               -- referenced by a strict-                                               -- 'S.ByteString'.-                   -> Builder                  -- ^ 'Builder' to run.-                   -> IO ()                    -- ^ Resulting 'IO' action.-toByteStringIOWith bufSize io (Builder b) =-    fillBuffer bufSize (b (buildStep finalStep))-  where-    finalStep !(BufRange pf _) = return $ Done pf ()--    fillBuffer !size step = do-        S.mallocByteString size >>= fill-      where-        fill fpbuf = do-            let !pf = unsafeForeignPtrToPtr fpbuf-                !br = BufRange pf (pf `plusPtr` size)-                -- safe due to later reference of fpbuf-                -- BETTER than withForeignPtr, as we lose a tail call otherwise-            signal <- runBuildStep step br-            case signal of-                Done pf' _ -> io $ S.PS fpbuf 0 (pf' `minusPtr` pf)--                BufferFull minSize pf' nextStep  -> do-                    io $ S.PS fpbuf 0 (pf' `minusPtr` pf)-                    fillBuffer (max bufSize minSize) nextStep--                InsertByteString pf' bs nextStep  -> do-                    io $ S.PS fpbuf 0 (pf' `minusPtr` pf)-                    unless (S.null bs) (io bs)-                    fillBuffer bufSize nextStep---- | Run the builder with a 'defaultBufferSize'd buffer and execute the given--- 'IO' action whenever the buffer is full or gets flushed.------ @ 'toByteStringIO' = 'toByteStringIOWith' 'defaultBufferSize'@------ This is a 'Monoid' homomorphism in the following sense.------ > toByteStringIO io mempty          == return ()--- > toByteStringIO io (x `mappend` y) == toByteStringIO io x >> toByteStringIO io y----toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO ()-toByteStringIO = toByteStringIOWith defaultBufferSize-{-# INLINE toByteStringIO #-}--unsafeIO :: IO a -> a-#if MIN_VERSION_base(4,4,0)-unsafeIO = unsafeDupablePerformIO-#else-unsafeIO = unsafePerformIO-#endif---- | Run a 'Write' to produce a strict 'S.ByteString'.--- This is equivalent to @('toByteString' . 'fromWrite')@, but is more--- efficient because it uses just one appropriately-sized buffer.-writeToByteString :: Write -> S.ByteString-writeToByteString !w = unsafeIO $ do-    fptr <- S.mallocByteString (getBound w)-    len <- withForeignPtr fptr $ \ptr -> do-        end <- runWrite w ptr-        return $! end `minusPtr` ptr-    return $! S.fromForeignPtr fptr 0 len-{-# INLINE writeToByteString #-}----------------------------------------------------------------------------------- Draft of new builder/put execution code---------------------------------------------------------------------------------{- FIXME: Generalize this code such that it can replace the above clunky- - implementations.---- | A monad for lazily composing lazy bytestrings using continuations.-newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) }--instance Monad LBSM where-    return x                       = LBSM (x, id)-    (LBSM (x,k)) >>= f             = let LBSM (x',k') = f x in LBSM (x', k . k')-    (LBSM (_,k)) >> (LBSM (x',k')) = LBSM (x', k . k')---- | Execute a put and return the written buffers as the chunks of a lazy--- bytestring.-toLazyByteString :: Put a -> (a, L.ByteString)-toLazyByteString put =-    (fst result, k (bufToLBSCont (snd result) L.empty))-  where--    -- FIXME: Check with ByteString guys why allocation in inlinePerformIO is-    -- bad.--    -- initial buffer-    buf0 = S.inlinePerformIO $ allocBuffer defaultBufferSize-    -- run put, but don't force result => we're lazy enough-    LBSM (result, k) = runPut liftIO outputBuf outputBS put buf0-    -- convert a buffer to a lazy bytestring continuation-    bufToLBSCont = maybe id L.Chunk . unsafeFreezeNonEmptyBuffer-    -- lifting an io putsignal to a lazy bytestring monad-    liftIO io = LBSM (S.inlinePerformIO io, id)-    -- add buffer as a chunk prepare allocation of new one-    outputBuf minSize buf = LBSM-        ( S.inlinePerformIO $ allocBuffer (max minSize defaultBufferSize)-        , bufToLBSCont buf )-    -- add bytestring directly as a chunk; exploits postcondition of runPut-    -- that bytestrings are non-empty-    outputBS bs = LBSM ((), L.Chunk bs)---{---- | A Builder that traces a message-traceBuilder :: String -> Builder-traceBuilder msg = fromBuildStepCont $ \k br@(BufRange op ope) -> do-    putStrLn $ "traceBuilder " ++ show (op, ope) ++ ": " ++ msg-    k br--test2 :: Word8 -> [S.ByteString]-test2 x = L.toChunks $ toLazyByteString2 $ fromBuilder $ mconcat-  [ traceBuilder "before flush"-  , fromWord8 48-  , flushBuilder-  , flushBuilder-  , traceBuilder "after flush"-  , fromWord8 x-  ]---}---}
− Blaze/ByteString/Builder/Internal/Buffer.hs
@@ -1,223 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module      : Blaze.ByteString.Builder.Internal.Buffer--- Copyright   : (c) 2010 Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only------ Execution of the 'Put' monad and hence also 'Builder's with respect to--- buffers.----module Blaze.ByteString.Builder.Internal.Buffer (-  -- * Buffers-    Buffer (..)--  -- ** Status information-  , freeSize-  , sliceSize-  , bufferSize--  -- ** Creation and modification-  , allocBuffer-  , reuseBuffer-  , nextSlice-  , updateEndOfSlice-  , execBuildStep--  -- ** Conversion to bytestings-  , unsafeFreezeBuffer-  , unsafeFreezeNonEmptyBuffer--  -- * Buffer allocation strategies-  , BufferAllocStrategy-  , allNewBuffersStrategy-  , reuseBufferStrategy--  -- * Executing puts respect to some monad-  , runPut-  ) where--#ifdef HAS_FOREIGN_UNSAFE_MODULE-import Foreign                   (Word8, ForeignPtr, Ptr, plusPtr, minusPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#else-import Foreign                   (unsafeForeignPtrToPtr, Word8, ForeignPtr, Ptr, plusPtr, minusPtr)-#endif--import qualified Data.ByteString      as S--#ifdef BYTESTRING_IN_BASE-import qualified Data.ByteString.Base as S-#else-import qualified Data.ByteString.Internal as S-#endif--import Blaze.ByteString.Builder.Internal.Types---------------------------------------------------------------------------------- Buffers----------------------------------------------------------------------------------- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying--- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free--- space @op..ope@.-data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array-                     {-# UNPACK #-} !(Ptr Word8)        -- beginning of slice-                     {-# UNPACK #-} !(Ptr Word8)        -- next free byte-                     {-# UNPACK #-} !(Ptr Word8)        -- first byte after buffer---- | The size of the free space of the buffer.-freeSize :: Buffer -> Int-freeSize (Buffer _ _ op ope) = ope `minusPtr` op---- | The size of the written slice in the buffer.-sliceSize :: Buffer -> Int-sliceSize (Buffer _ p0 op _) = op `minusPtr` p0---- | The size of the whole byte array underlying the buffer.-bufferSize :: Buffer -> Int-bufferSize (Buffer fpbuf _ _ ope) =-    ope `minusPtr` unsafeForeignPtrToPtr fpbuf---- | @allocBuffer size@ allocates a new buffer of size @size@.-{-# INLINE allocBuffer #-}-allocBuffer :: Int -> IO Buffer-allocBuffer size = do-    fpbuf <- S.mallocByteString size-    let !pbuf = unsafeForeignPtrToPtr fpbuf-    return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size)---- | Resets the beginning of the next slice and the next free byte such that--- the whole buffer can be filled again.-{-# INLINE reuseBuffer #-}-reuseBuffer :: Buffer -> Buffer-reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope-  where-    p0 = unsafeForeignPtrToPtr fpbuf---- | Convert the buffer to a bytestring. This operation is unsafe in the sense--- that created bytestring shares the underlying byte array with the buffer.--- Hence, depending on the later use of this buffer (e.g., if it gets reset and--- filled again) referential transparency may be lost.-{-# INLINE unsafeFreezeBuffer #-}-unsafeFreezeBuffer :: Buffer -> S.ByteString-unsafeFreezeBuffer (Buffer fpbuf p0 op _) =-    S.PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0)---- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for--- the explanation of why this operation may be unsafe.-{-# INLINE unsafeFreezeNonEmptyBuffer #-}-unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString-unsafeFreezeNonEmptyBuffer buf-  | sliceSize buf <= 0 = Nothing-  | otherwise          = Just $ unsafeFreezeBuffer buf---- | Update the end of slice pointer.-{-# INLINE updateEndOfSlice #-}-updateEndOfSlice :: Buffer    -- Old buffer-                 -> Ptr Word8 -- New end of slice-                 -> Buffer    -- Updated buffer-updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope---- | Execute a build step on the given buffer.-{-# INLINE execBuildStep #-}-execBuildStep :: BuildStep a-              -> Buffer-              -> IO (BuildSignal a)-execBuildStep step (Buffer _ _ op ope) = runBuildStep step (BufRange op ope)---- | Move the beginning of the slice to the next free byte such that the--- remaining free space of the buffer can be filled further. This operation--- is safe and can be used to fill the remaining part of the buffer after a--- direct insertion of a bytestring or a flush.-{-# INLINE nextSlice #-}-nextSlice :: Int -> Buffer -> Maybe Buffer-nextSlice minSize (Buffer fpbuf _ op ope)-  | ope `minusPtr` op <= minSize = Nothing-  | otherwise                    = Just (Buffer fpbuf op op ope)----------------------------------------------------------------------------------- Buffer allocation strategies----------------------------------------------------------------------------------- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial--- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at--- least size @minSize@ from a filled buffer @buf@. The double nesting of the--- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is--- lost as soon as possible, but the new buffer doesn't have to be allocated--- too early.-type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))---- | The simplest buffer allocation strategy: whenever a buffer is requested,--- allocate a new one that is big enough for the next build step to execute.------ NOTE that this allocation strategy may spill quite some memory upon direct--- insertion of a bytestring by the builder. Thats no problem for garbage--- collection, but it may lead to unreasonably high memory consumption in--- special circumstances.-allNewBuffersStrategy :: Int                 -- Minimal buffer size.-                      -> BufferAllocStrategy-allNewBuffersStrategy bufSize =-    ( allocBuffer bufSize-    , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) )---- | An unsafe, but possibly more efficient buffer allocation strategy:--- reuse the buffer, if it is big enough for the next build step to execute.-reuseBufferStrategy :: IO Buffer-                    -> BufferAllocStrategy-reuseBufferStrategy buf0 =-    (buf0, tryReuseBuffer)-  where-    tryReuseBuffer reqSize buf-      | bufferSize buf >= reqSize = return $ return (reuseBuffer buf)-      | otherwise                 = return $ allocBuffer reqSize----------------------------------------------------------------------------------- Executing puts on a buffer------------------------------------------------------------------------------------ | Execute a put on a buffer.------ TODO: Generalize over buffer allocation strategy.-{-# INLINE runPut #-}-runPut :: Monad m-       => (IO (BuildSignal a) -> m (BuildSignal a)) -- lifting of buildsteps-       -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next-       -> (S.ByteString -> m ())    -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream-       -> Put a                     -- put to execute-       -> Buffer                    -- initial buffer to be used-       -> m (a, Buffer)             -- result of put and remaining buffer-runPut liftIO outputBuf outputBS (Put put) =-    runStep (put (finalStep))-  where-    finalStep x = buildStep $ \(BufRange op _) -> return $ Done op x--    runStep step buf@(Buffer fpbuf p0 op ope) = do-        let !br = BufRange op ope-        signal <- liftIO $ runBuildStep step br-        case signal of-            Done op' x ->         -- put completed, buffer partially runSteped-                return (x, Buffer fpbuf p0 op' ope)--            BufferFull minSize op' nextStep -> do-                buf' <- outputBuf minSize (Buffer fpbuf p0 op' ope)-                runStep nextStep buf'--            InsertByteString op' bs nextStep-              | S.null bs ->   -- flushing of buffer required-                  outputBuf 1 (Buffer fpbuf p0 op' ope) >>= runStep nextStep-              | p0 == op' -> do -- no bytes written: just insert bytestring-                  outputBS bs-                  runStep nextStep buf-              | otherwise -> do   -- bytes written, insert buffer and bytestring-                  buf' <- outputBuf 1 (Buffer fpbuf p0 op' ope)-                  outputBS bs-                  runStep nextStep buf'
− Blaze/ByteString/Builder/Internal/Types.hs
@@ -1,144 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module      : Blaze.ByteString.Builder.Internal.Types--- Copyright   : (c) 2010 Simon Meier--- License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only------ Core types and functions for the 'Builder' monoid and the 'Put' monad based--- based on the 'blaze-builder' library by Jasper van der Jeugt and Simon--- Meier.----module Blaze.ByteString.Builder.Internal.Types where--import Control.Applicative--import Data.Monoid-import qualified Data.ByteString      as S--import Foreign----------------------------------------------------------------------------------- The core: BuildSteps---------------------------------------------------------------------------------data BufRange = BufRange {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(Ptr Word8)--data BuildSignal a =-    Done {-# UNPACK #-} !(Ptr Word8) a-  | BufferFull-      {-# UNPACK #-} !Int-      {-# UNPACK #-} !(Ptr Word8)-                     !(BuildStep a)-  | InsertByteString-      {-# UNPACK #-} !(Ptr Word8)-                     !S.ByteString-                     !(BuildStep a)--newtype BuildStep a =-    BuildStep { runBuildStep :: BufRange -> IO (BuildSignal a) }---- Hiding the implementation of 'BuildStep's--done :: Ptr Word8 -> a -> BuildSignal a-done = Done--bufferFull :: Int -> Ptr Word8 -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a-bufferFull size op step = BufferFull size op (buildStep step)--insertByteString :: Ptr Word8 -> S.ByteString -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a-insertByteString op bs step = InsertByteString op bs (buildStep step)--buildStep :: (BufRange -> IO (BuildSignal a)) -> BuildStep a-buildStep = BuildStep----------------------------------------------------------------------------------- The 'Builder' Monoid and the 'Put' Monad---------------------------------------------------------------------------------newtype Builder = Builder {-    unBuilder :: forall r. BuildStep r -> BuildStep r-  }--instance Monoid Builder where-  mempty = Builder id-  {-# INLINE mempty #-}-  (Builder b1) `mappend` (Builder b2) = Builder $ b1 . b2-  {-# INLINE mappend #-}-  mconcat = foldr mappend mempty-  {-# INLINE mconcat #-}--newtype Put a = Put {-    unPut :: forall r. (a -> BuildStep r) -> BuildStep r-  }--instance Functor Put where-  fmap f (Put put) = Put $ \k -> put (\x -> k (f x))-  {-# INLINE fmap #-}--instance Applicative Put where-  pure x = Put $ \k -> k x-  {-# INLINE pure #-}-  f <*> a = Put $ \k -> unPut f (\f' -> unPut a (\a' -> k (f' a')))-  {-# INLINE (<*>) #-}-  a <* b = Put $ \k -> unPut a (\a' -> unPut b (\_ -> k a'))-  {-# INLINE (<*) #-}-  a *> b = Put $ \k -> unPut a (\_ -> unPut b k)-  {-# INLINE (*>) #-}--instance Monad Put where-  return x = Put $ \k -> k x-  {-# INLINE return #-}-  m >>= f  = Put $ \k -> unPut m (\m' -> unPut (f m') k)-  {-# INLINE (>>=) #-}-  m >>  n  = Put $ \k -> unPut m (\_ -> unPut n k)-  {-# INLINE (>>) #-}----- Creation from concrete 'BuildStep's---------------------------------------------------------------------------------putBuildStepCont :: (forall r. (a -> BufRange -> IO (BuildSignal r)) ->-                               (     BufRange -> IO (BuildSignal r))-                    ) -> Put a-putBuildStepCont step = Put step'-  where-    step' k = BuildStep $ step (\x -> runBuildStep (k x))---fromBuildStepCont :: (forall r. (BufRange -> IO (BuildSignal r)) ->-                                (BufRange -> IO (BuildSignal r))-                     ) -> Builder-fromBuildStepCont step = Builder step'-  where-    step' k = BuildStep $ step (runBuildStep k)------ Conversion between Put and Builder----------------------------------------------------------------------------------- | Put the given builder.-putBuilder :: Builder -> Put ()-putBuilder (Builder build) = Put $ \k -> build (k ())----- | Ignore the value of a put and only exploit its output side effect.-fromPut :: Put a -> Builder-fromPut (Put put) = Builder $ \k -> put (\_ -> k)---- Lifting IO actions-------------------------- | Lift the given IO action.-{-# INLINE putLiftIO #-}-putLiftIO :: IO a -> Put a-putLiftIO io = putBuildStepCont $ \k br -> io >>= (`k` br)
− Blaze/ByteString/Builder/Internal/UncheckedShifts.hs
@@ -1,78 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif---- |--- Module      : Blaze.ByteString.Builder.Internal.UncheckedShifts--- Copyright   : (c) 2010 Simon Meier------               Original serialization code from 'Data.Binary.Builder':---               (c) Lennart Kolmodin, Ross Patterson------ License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only------ Utilty module defining unchecked shifts.----#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-#include "MachDeps.h"-#endif--module Blaze.ByteString.Builder.Internal.UncheckedShifts (-    shiftr_w16-  , shiftr_w32-  , shiftr_w64-  ) where---- TODO: Check validity of this implementation--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base-import GHC.Word (Word32(..),Word16(..),Word64(..))--#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608-import GHC.Word (uncheckedShiftRL64#)-#endif-#else-import Data.Word-#endif------------------------------------------------------------------------------ Unchecked shifts--{-# INLINE shiftr_w16 #-}-shiftr_w16 :: Word16 -> Int -> Word16-{-# INLINE shiftr_w32 #-}-shiftr_w32 :: Word32 -> Int -> Word32-{-# INLINE shiftr_w64 #-}-shiftr_w64 :: Word64 -> Int -> Word64--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)--#if WORD_SIZE_IN_BITS < 64-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)--#if __GLASGOW_HASKELL__ <= 606--- Exported by GHC.Word in GHC 6.8 and higher-foreign import ccall unsafe "stg_uncheckedShiftRL64"-    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#-#endif--#else-shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)-#endif--#else-shiftr_w16 = shiftR-shiftr_w32 = shiftR-shiftr_w64 = shiftR-#endif-
Blaze/ByteString/Builder/Internal/Write.hs view
@@ -1,15 +1,12 @@-{-# LANGUAGE CPP, BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns, MonoPatBinds #-} -#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif -- | -- Module      : Blaze.ByteString.Builder.Internal.Poke -- Copyright   : (c) 2010 Simon Meier --               (c) 2010 Jasper van der Jeugt -- License     : BSD3-style (see LICENSE) ----- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --@@ -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'@@ -57,8 +53,7 @@  import Control.Monad -import Blaze.ByteString.Builder.Internal.Types-+import Data.ByteString.Builder.Internal  ------------------------------------------------------------------------------ -- Poking a buffer and writing to a buffer@@ -150,7 +145,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 +214,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 +228,29 @@ fromWriteSingleton write =     mkBuilder   where-    mkBuilder x = fromBuildStepCont step+    mkBuilder x = builder step       where-        step k (BufRange op ope)+        step k (BufferRange op ope)           | op `plusPtr` maxSize <= ope = do               op' <- runPoke wio op-              let !br' = BufRange op' ope+              let !br' = BufferRange op' ope               k br'           | otherwise = return $ bufferFull maxSize op (step k)           where             Write maxSize wio = write x + -- | Construct a 'Builder' writing a list of data one element at a time. fromWriteList :: (a -> Write) -> [a] -> Builder fromWriteList write =     makeBuilder   where-    makeBuilder xs0 = fromBuildStepCont $ step xs0+    makeBuilder xs0 = builder $ step xs0       where-        step xs1 k !(BufRange op0 ope0) = go xs1 op0+        step xs1 k !(BufferRange op0 ope0) = go xs1 op0           where             go [] !op = do-               let !br' = BufRange op ope0+               let !br' = BufferRange op ope0                k br'              go xs@(x':xs') !op
Blaze/ByteString/Builder/Word.hs view
@@ -1,21 +1,10 @@-{-# LANGUAGE CPP #-}--#ifdef USE_MONO_PAT_BINDS-{-# LANGUAGE MonoPatBinds #-}-#endif-+------------------------------------------------------------------------------ -- |--- Module      : Blaze.ByteString.Builder.Word--- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier------               Original serialization code from 'Data.Binary.Builder':---               (c) Lennart Kolmodin, Ross Patterson------ License     : BSD3-style (see LICENSE)------ Maintainer  : Simon Meier <iridcode@gmail.com>--- Stability   : experimental--- Portability : tested on GHC only+-- Module:      Blaze.ByteString.Builder.Word+-- Copyright:   (c) 2013 Leon P Smith+-- License:     BSD3+-- Maintainer:  Leon P Smith <leon@melding-monads.com>+-- Stability:   experimental -- -- '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 #-}
benchmarks/BenchThroughput.hs view
@@ -4,7 +4,7 @@ -- Copyright   : Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : GHC --
benchmarks/BlazeVsBinary.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Jasper Van der Jeught & Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/BoundedWrite.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/BuilderBufferRange.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/ChunkedWrite.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/Compression.hs view
@@ -3,7 +3,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/FastPut.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/LazyByteString.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/PlotTest.hs view
@@ -4,7 +4,7 @@ -- Copyright   : Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : GHC --
benchmarks/StringAndText.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/UnboxedAppend.hs view
@@ -4,7 +4,7 @@ -- Copyright   : (c) 2010 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
benchmarks/Utf8IO.hs view
@@ -3,7 +3,7 @@ -- Copyright   : (c) 2011 Simon Meier -- License     : BSD3-style (see LICENSE) -- --- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Maintainer  : Leon P Smith <leon@melding-monads.com> -- Stability   : experimental -- Portability : tested on GHC only --
blaze-builder.cabal view
@@ -1,35 +1,42 @@ Name:                blaze-builder-Version:             0.3.3.4+Version:             0.4.0.0 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 provides an implementation of the older+                     blaze-builder interface in terms of the new builder that+                     shipped with bytestring-0.10.4.0+                     .+                     This implementation is mostly intended as a bridge to the+                     new builder,  so that code that uses the old interface+                     can interoperate with code that uses the new+                     implementation.   Note that no attempt has been made+                     to preserve the old internal modules,  so code that+                     has these dependencies cannot use this interface.+                     .+                     New code should,  for the most part,  use the new+                     interface.   However, this module does implement+                     a chunked HTTP encoding,  which is not otherwise+                     implemented (yet?) with the new builder. -Author:              Jasper Van der Jeugt, Simon Meier-Copyright:           2010-2014 Simon Meier-                     2010 Jasper Van der Jeugt-Maintainer:          Simon Meier <iridcode@gmail.com>+Author:              Jasper Van der Jeugt, Simon Meier, Leon P Smith+Copyright:           (c) 2010-2014 Simon Meier+                     (c) 2010 Jasper Van der Jeugt+                     (c) 2013-2015 Leon P Smith+Maintainer:          Leon Smith <leon@melding-monads.com>  License:             BSD3 License-file:        LICENSE -Homepage:            http://github.com/meiersi/blaze-builder-Bug-Reports:         http://github.com/meiersi/blaze-builder/issues+Homepage:            http://github.com/lpsmith/blaze-builder+Bug-Reports:         http://github.com/lpsmith/blaze-builder/issues Stability:           Experimental  Category:            Data Build-type:          Simple-Cabal-version:       >= 1.6+Cabal-version:       >= 1.8 -Extra-source-files:  +Extra-source-files:                      Makefile                      README.markdown                      TODO@@ -49,14 +56,6 @@ 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-   exposed-modules:   Blaze.ByteString.Builder                      Blaze.ByteString.Builder.Int                      Blaze.ByteString.Builder.Word@@ -65,14 +64,33 @@                      Blaze.ByteString.Builder.Char8                      Blaze.ByteString.Builder.Html.Utf8                      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 ,+                     bytestring >= 0.9 && < 1.0,+                     deepseq,                      text >= 0.10 && < 1.3++  if impl(ghc < 7.8)+     build-depends:  bytestring-builder++test-suite test+  type:           exitcode-stdio-1.0++  hs-source-dirs: tests+  main-is:        Tests.hs++  ghc-options: -Wall -fno-warn-orphans++  build-depends: base+               , blaze-builder+               , bytestring+               , HUnit+               , QuickCheck+               , test-framework+               , test-framework-hunit+               , test-framework-quickcheck2+               , text+               , utf8-string
tests/Tests.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+#if __GLASGOW_HASKELL__ >= 704+{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-}+#endif -- | Tests for the Blaze builder ---{-# LANGUAGE OverloadedStrings #-}-module Tests where+module Main where  import Control.Applicative ((<$>)) import Data.Monoid (mempty, mappend, mconcat)