diff --git a/Blaze/ByteString/Builder.hs b/Blaze/ByteString/Builder.hs --- a/Blaze/ByteString/Builder.hs +++ b/Blaze/ByteString/Builder.hs @@ -1,12 +1,13 @@ ------------------------------------------------------------------------------ +{-# LANGUAGE CPP, BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder --- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} diff --git a/Blaze/ByteString/Builder/ByteString.hs b/Blaze/ByteString/Builder/ByteString.hs --- a/Blaze/ByteString/Builder/ByteString.hs +++ b/Blaze/ByteString/Builder/ByteString.hs @@ -1,21 +1,12 @@ -{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder.ByteString --- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder.ByteString +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} - diff --git a/Blaze/ByteString/Builder/Char/Utf8.hs b/Blaze/ByteString/Builder/Char/Utf8.hs --- a/Blaze/ByteString/Builder/Char/Utf8.hs +++ b/Blaze/ByteString/Builder/Char/Utf8.hs @@ -1,18 +1,16 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} --- ignore warning from 'import Data.Text.Encoding' - +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder.Char.Utf8 --- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder.Char.Utf8 +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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. -- diff --git a/Blaze/ByteString/Builder/Char8.hs b/Blaze/ByteString/Builder/Char8.hs --- a/Blaze/ByteString/Builder/Char8.hs +++ b/Blaze/ByteString/Builder/Char8.hs @@ -1,20 +1,10 @@ --- ignore warning from 'import Data.Text.Encoding' -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - -{-# LANGUAGE CPP #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder.Char8 --- Copyright : (c) 2010 Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder.Char8 +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} diff --git a/Blaze/ByteString/Builder/Compat/Write.hs b/Blaze/ByteString/Builder/Compat/Write.hs new file mode 100644 --- /dev/null +++ b/Blaze/ByteString/Builder/Compat/Write.hs @@ -0,0 +1,29 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Blaze.ByteString.Builder.Compat.Write +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} diff --git a/Blaze/ByteString/Builder/HTTP.hs b/Blaze/ByteString/Builder/HTTP.hs --- a/Blaze/ByteString/Builder/HTTP.hs +++ b/Blaze/ByteString/Builder/HTTP.hs @@ -1,37 +1,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 +-- 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" - - diff --git a/Blaze/ByteString/Builder/Html/Utf8.hs b/Blaze/ByteString/Builder/Html/Utf8.hs --- a/Blaze/ByteString/Builder/Html/Utf8.hs +++ b/Blaze/ByteString/Builder/Html/Utf8.hs @@ -1,12 +1,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 --- 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 +-- 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 "<" - io '>' = getPoke $ writeByteString ">" - io '&' = getPoke $ writeByteString "&" - io '"' = getPoke $ writeByteString """ - io '\'' = getPoke $ writeByteString "'" - io c = getPoke $ writeChar c +writeHtmlEscapedChar = writePrimBounded charUtf8HtmlEscaped {-# INLINE writeHtmlEscapedChar #-} -- | /O(1)./ Serialize a HTML escaped Unicode character using the UTF-8 -- encoding. --- -fromHtmlEscapedChar :: Char -> Builder -fromHtmlEscapedChar = fromWriteSingleton writeHtmlEscapedChar +fromHtmlEscapedChar :: Char -> B.Builder +fromHtmlEscapedChar = P.primBounded charUtf8HtmlEscaped +{-# INLINE fromHtmlEscapedChar #-} +{-# INLINE charUtf8HtmlEscaped #-} +charUtf8HtmlEscaped :: P.BoundedPrim Char +charUtf8HtmlEscaped = + condB (> '>' ) (condB (== '\DEL') P.emptyB P.charUtf8) $ + condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $ -- < + condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $ -- > + condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $ -- & + condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $ -- &#quot; + condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $ -- ' + condB (\c -> c >= ' ' || c == '\t' || c == '\n' || c == '\r') + (P.liftFixedToBounded P.char7) $ + P.emptyB + where + {-# INLINE fixed4 #-} + fixed4 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + + {-# INLINE fixed5 #-} + fixed5 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + + {-# INLINE fixed6 #-} + fixed6 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + -- | /O(n)/. Serialize a HTML escaped Unicode 'String' using the UTF-8 -- encoding. -- -fromHtmlEscapedString :: String -> Builder -fromHtmlEscapedString = fromWriteList writeHtmlEscapedChar +fromHtmlEscapedString :: String -> B.Builder +fromHtmlEscapedString = P.primMapListBounded charUtf8HtmlEscaped -- | /O(n)/. Serialize a value by 'Show'ing it and then, HTML escaping and -- UTF-8 encoding the resulting 'String'. -- -fromHtmlEscapedShow :: Show a => a -> Builder +fromHtmlEscapedShow :: Show a => a -> B.Builder fromHtmlEscapedShow = fromHtmlEscapedString . show - -- | /O(n)/. Serialize a HTML escaped strict Unicode 'TS.Text' value using the -- UTF-8 encoding. -- -fromHtmlEscapedText :: TS.Text -> Builder +fromHtmlEscapedText :: 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 - diff --git a/Blaze/ByteString/Builder/Int.hs b/Blaze/ByteString/Builder/Int.hs --- a/Blaze/ByteString/Builder/Int.hs +++ b/Blaze/ByteString/Builder/Int.hs @@ -1,24 +1,18 @@ -{-# LANGUAGE CPP #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder.Int --- Copyright : (c) 2010 Simon Meier --- --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder.Int +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} diff --git a/Blaze/ByteString/Builder/Internal.hs b/Blaze/ByteString/Builder/Internal.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal.hs +++ /dev/null @@ -1,446 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, Rank2Types #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - --- | --- Module : Blaze.ByteString.Builder.Internal --- Copyright : (c) 2010 Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only --- --- Core types and functions for the 'Builder' monoid and the 'Put' monad. --- -module Blaze.ByteString.Builder.Internal ( - - -- * Build Steps - BufRange(..) - , BuildSignal - , BuildStep - , done - , bufferFull - , insertByteString - - -- * Builder - , Builder - , fromBuildStepCont - , fromPut - , flush - - -- * Put - , Put - , putBuilder - , putBuildStepCont - , putLiftIO - - -- * Writes - , module Blaze.ByteString.Builder.Internal.Write - , writeToByteString - - -- * Execution - , toLazyByteString - , toLazyByteStringWith - , toByteString - , toByteStringIO - , toByteStringIOWith - - -- * Deafult Sizes - , defaultFirstBufferSize - , defaultMinimalBufferSize - , defaultBufferSize - , defaultMaximalCopySize -) where - -#ifdef HAS_FOREIGN_UNSAFE_MODULE -import Foreign (withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr) -import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) -#else -import Foreign (unsafeForeignPtrToPtr, withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr) -#endif - -import Control.Monad (unless) -#if MIN_VERSION_base(4,4,0) -import System.IO.Unsafe (unsafeDupablePerformIO) -#else -import System.IO.Unsafe (unsafePerformIO) -#endif - -import qualified Data.ByteString as S -import qualified Data.ByteString.Internal as S -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Internal as L - -import Blaze.ByteString.Builder.Internal.Types -import Blaze.ByteString.Builder.Internal.Write - ------------------------------------------------------------------------------- --- Internal global constants. ------------------------------------------------------------------------------- - --- | Default size (~32kb) for the buffer that becomes a chunk of the output --- stream once it is filled. --- -defaultBufferSize :: Int -defaultBufferSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy. - where overhead = 2 * sizeOf (undefined :: Int) - --- | The minimal length (~4kb) a buffer must have before filling it and --- outputting it as a chunk of the output stream. --- --- This size determines when a buffer is spilled after a 'flush' or a direct --- bytestring insertion. It is also the size of the first chunk generated by --- 'toLazyByteString'. -defaultMinimalBufferSize :: Int -defaultMinimalBufferSize = 4 * 1024 - overhead - where overhead = 2 * sizeOf (undefined :: Int) - --- | The default length (64) for the first buffer to be allocated when --- converting a 'Builder' to a lazy bytestring. --- --- See 'toLazyByteStringWith' for further explanation. -defaultFirstBufferSize :: Int -defaultFirstBufferSize = 64 - --- | The maximal number of bytes for that copying is cheaper than direct --- insertion into the output stream. This takes into account the fragmentation --- that may occur in the output buffer due to the early 'flush' implied by the --- direct bytestring insertion. --- --- @'defaultMaximalCopySize' = 2 * 'defaultMinimalBufferSize'@ --- -defaultMaximalCopySize :: Int -defaultMaximalCopySize = 2 * defaultMinimalBufferSize - ------------------------------------------------------------------------------- --- Flushing and running a Builder ------------------------------------------------------------------------------- - --- | Prepend the chunk if it is non-empty. -{-# INLINE nonEmptyChunk #-} -nonEmptyChunk :: S.ByteString -> L.ByteString -> L.ByteString -nonEmptyChunk bs lbs | S.null bs = lbs - | otherwise = L.Chunk bs lbs - - --- | Output all data written in the current buffer and start a new chunk. --- --- The use of this function depends on how the resulting bytestrings are --- consumed. 'flush' is possibly not very useful in non-interactive scenarios. --- However, it is kept for compatibility with the builder provided by --- Data.Binary.Builder. --- --- When using 'toLazyByteString' to extract a lazy 'L.ByteString' from a --- 'Builder', this means that a new chunk will be started in the resulting lazy --- 'L.ByteString'. The remaining part of the buffer is spilled, if the --- reamining free space is smaller than the minimal desired buffer size. --- -{-# INLINE flush #-} -flush :: Builder -flush = fromBuildStepCont step - where - step k !(BufRange op _) = return $ insertByteString op S.empty k - --- | Run a 'Builder' with the given buffer sizes. --- --- Use this function for integrating the 'Builder' type with other libraries --- that generate lazy bytestrings. --- --- Note that the builders should guarantee that on average the desired chunk --- size is attained. Builders may decide to start a new buffer and not --- completely fill the existing buffer, if this is faster. However, they should --- not spill too much of the buffer, if they cannot compensate for it. --- --- A call @toLazyByteStringWith bufSize minBufSize firstBufSize@ will generate --- a lazy bytestring according to the following strategy. First, we allocate --- a buffer of size @firstBufSize@ and start filling it. If it overflows, we --- allocate a buffer of size @minBufSize@ and copy the first buffer to it in --- order to avoid generating a too small chunk. Finally, every next buffer will --- be of size @bufSize@. This, slow startup strategy is required to achieve --- good speed for short (<200 bytes) resulting bytestrings, as for them the --- allocation cost is of a large buffer cannot be compensated. Moreover, this --- strategy also allows us to avoid spilling too much memory for short --- resulting bytestrings. --- --- Note that setting @firstBufSize >= minBufSize@ implies that the first buffer --- is no longer copied but allocated and filled directly. Hence, setting --- @firstBufSize = bufSize@ means that all chunks will use an underlying buffer --- of size @bufSize@. This is recommended, if you know that you always output --- more than @minBufSize@ bytes. -toLazyByteStringWith - :: Int -- ^ Buffer size (upper-bounds the resulting chunk size). - -> Int -- ^ Minimal free buffer space for continuing filling - -- the same buffer after a 'flush' or a direct bytestring - -- insertion. This corresponds to the minimal desired - -- chunk size. - -> Int -- ^ Size of the first buffer to be used and copied for - -- larger resulting sequences - -> Builder -- ^ Builder to run. - -> L.ByteString -- ^ Lazy bytestring to output after the builder is - -- finished. - -> L.ByteString -- ^ Resulting lazy bytestring -toLazyByteStringWith bufSize minBufSize firstBufSize (Builder b) k = - S.inlinePerformIO $ fillFirstBuffer (b (buildStep finalStep)) - where - finalStep (BufRange pf _) = return $ Done pf () - -- fill a first very small buffer, if we need more space then copy it - -- to the new buffer of size 'minBufSize'. This way we don't pay the - -- allocation cost of the big 'bufSize' buffer, when outputting only - -- small sequences. - fillFirstBuffer !step0 - | minBufSize <= firstBufSize = fillNewBuffer firstBufSize step0 - | otherwise = do - fpbuf <- S.mallocByteString firstBufSize - withForeignPtr fpbuf $ \pf -> do - let !pe = pf `plusPtr` firstBufSize - mkbs pf' = S.PS fpbuf 0 (pf' `minusPtr` pf) - {-# INLINE mkbs #-} - next <- runBuildStep step0 (BufRange pf pe) - case next of - Done pf' _ - | pf' == pf -> return k - | otherwise -> return $ L.Chunk (mkbs pf') k - - BufferFull newSize pf' nextStep -> do - let !l = pf' `minusPtr` pf - fillNewBuffer (max (l + newSize) minBufSize) $ buildStep $ - \(BufRange pfNew peNew) -> do - copyBytes pfNew pf l - let !br' = BufRange (pfNew `plusPtr` l) peNew - runBuildStep nextStep br' - - InsertByteString pf' bs nextStep - | pf' == pf -> - return $ nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep) - | otherwise -> - return $ L.Chunk (mkbs pf') - (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep)) - - -- allocate and fill a new buffer - fillNewBuffer !size !step0 = do - fpbuf <- S.mallocByteString size - withForeignPtr fpbuf $ fillBuffer fpbuf - where - fillBuffer fpbuf !pbuf = fill pbuf step0 - where - !pe = pbuf `plusPtr` size - fill !pf !step = do - next <- runBuildStep step (BufRange pf pe) - let mkbs pf' = S.PS fpbuf (pf `minusPtr` pbuf) (pf' `minusPtr` pf) - {-# INLINE mkbs #-} - case next of - Done pf' _ - | pf' == pf -> return k - | otherwise -> return $ L.Chunk (mkbs pf') k - - BufferFull newSize pf' nextStep - | pf' == pf -> - fillNewBuffer (max newSize bufSize) nextStep - | otherwise -> - return $ L.Chunk (mkbs pf') - (S.inlinePerformIO $ - fillNewBuffer (max newSize bufSize) nextStep) - - InsertByteString pf' bs nextStep - | pf' == pf -> - return $ nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep) - | minBufSize < pe `minusPtr` pf' -> - return $ L.Chunk (mkbs pf') - (nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep)) - | otherwise -> - return $ L.Chunk (mkbs pf') - (nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep)) - - --- | Extract the lazy 'L.ByteString' from the builder by running it with default --- buffer sizes. Use this function, if you do not have any special --- considerations with respect to buffer sizes. --- --- @ 'toLazyByteString' b = 'toLazyByteStringWith' 'defaultBufferSize' 'defaultMinimalBufferSize' 'defaultFirstBufferSize' b L.empty@ --- --- Note that @'toLazyByteString'@ is a 'Monoid' homomorphism. --- --- > toLazyByteString mempty == mempty --- > toLazyByteString (x `mappend` y) == toLazyByteString x `mappend` toLazyByteString y --- --- However, in the second equation, the left-hand-side is generally faster to --- execute. --- -toLazyByteString :: Builder -> L.ByteString -toLazyByteString b = toLazyByteStringWith - defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty -{-# INLINE toLazyByteString #-} - --- | Pack the chunks of a lazy bytestring into a single strict bytestring. -packChunks :: L.ByteString -> S.ByteString -packChunks lbs = do - S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs) - where - copyChunks !L.Empty !_pf = return () - copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do - withForeignPtr fpbuf $ \pbuf -> - copyBytes pf (pbuf `plusPtr` o) l - copyChunks lbs' (pf `plusPtr` l) - --- | Run the builder to construct a strict bytestring containing the sequence --- of bytes denoted by the builder. This is done by first serializing to a lazy bytestring and then packing its --- chunks to a appropriately sized strict bytestring. --- --- > toByteString = packChunks . toLazyByteString --- --- Note that @'toByteString'@ is a 'Monoid' homomorphism. --- --- > toByteString mempty == mempty --- > toByteString (x `mappend` y) == toByteString x `mappend` toByteString y --- --- However, in the second equation, the left-hand-side is generally faster to --- execute. --- -toByteString :: Builder -> S.ByteString -toByteString = packChunks . toLazyByteString - - --- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of --- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the --- buffer is full. --- --- Compared to 'toLazyByteStringWith' this function requires less allocation, --- as the output buffer is only allocated once at the start of the --- serialization and whenever something bigger than the current buffer size has --- to be copied into the buffer, which should happen very seldomly for the --- default buffer size of 32kb. Hence, the pressure on the garbage collector is --- reduced, which can be an advantage when building long sequences of bytes. --- -toByteStringIOWith :: Int -- ^ Buffer size (upper bounds - -- the number of bytes forced - -- per call to the 'IO' action). - -> (S.ByteString -> IO ()) -- ^ 'IO' action to execute per - -- full buffer, which is - -- referenced by a strict - -- 'S.ByteString'. - -> Builder -- ^ 'Builder' to run. - -> IO () -- ^ Resulting 'IO' action. -toByteStringIOWith bufSize io (Builder b) = - fillBuffer bufSize (b (buildStep finalStep)) - where - finalStep !(BufRange pf _) = return $ Done pf () - - fillBuffer !size step = do - S.mallocByteString size >>= fill - where - fill fpbuf = do - let !pf = unsafeForeignPtrToPtr fpbuf - !br = BufRange pf (pf `plusPtr` size) - -- safe due to later reference of fpbuf - -- BETTER than withForeignPtr, as we lose a tail call otherwise - signal <- runBuildStep step br - case signal of - Done pf' _ -> io $ S.PS fpbuf 0 (pf' `minusPtr` pf) - - BufferFull minSize pf' nextStep -> do - io $ S.PS fpbuf 0 (pf' `minusPtr` pf) - fillBuffer (max bufSize minSize) nextStep - - InsertByteString pf' bs nextStep -> do - io $ S.PS fpbuf 0 (pf' `minusPtr` pf) - unless (S.null bs) (io bs) - fillBuffer bufSize nextStep - --- | Run the builder with a 'defaultBufferSize'd buffer and execute the given --- 'IO' action whenever the buffer is full or gets flushed. --- --- @ 'toByteStringIO' = 'toByteStringIOWith' 'defaultBufferSize'@ --- --- This is a 'Monoid' homomorphism in the following sense. --- --- > toByteStringIO io mempty == return () --- > toByteStringIO io (x `mappend` y) == toByteStringIO io x >> toByteStringIO io y --- -toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO () -toByteStringIO = toByteStringIOWith defaultBufferSize -{-# INLINE toByteStringIO #-} - -unsafeIO :: IO a -> a -#if MIN_VERSION_base(4,4,0) -unsafeIO = unsafeDupablePerformIO -#else -unsafeIO = unsafePerformIO -#endif - --- | Run a 'Write' to produce a strict 'S.ByteString'. --- This is equivalent to @('toByteString' . 'fromWrite')@, but is more --- efficient because it uses just one appropriately-sized buffer. -writeToByteString :: Write -> S.ByteString -writeToByteString !w = unsafeIO $ do - fptr <- S.mallocByteString (getBound w) - len <- withForeignPtr fptr $ \ptr -> do - end <- runWrite w ptr - return $! end `minusPtr` ptr - return $! S.fromForeignPtr fptr 0 len -{-# INLINE writeToByteString #-} - ------------------------------------------------------------------------------- --- Draft of new builder/put execution code ------------------------------------------------------------------------------- - -{- FIXME: Generalize this code such that it can replace the above clunky - - implementations. - --- | A monad for lazily composing lazy bytestrings using continuations. -newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) } - -instance Monad LBSM where - return x = LBSM (x, id) - (LBSM (x,k)) >>= f = let LBSM (x',k') = f x in LBSM (x', k . k') - (LBSM (_,k)) >> (LBSM (x',k')) = LBSM (x', k . k') - --- | Execute a put and return the written buffers as the chunks of a lazy --- bytestring. -toLazyByteString :: Put a -> (a, L.ByteString) -toLazyByteString put = - (fst result, k (bufToLBSCont (snd result) L.empty)) - where - - -- FIXME: Check with ByteString guys why allocation in inlinePerformIO is - -- bad. - - -- initial buffer - buf0 = S.inlinePerformIO $ allocBuffer defaultBufferSize - -- run put, but don't force result => we're lazy enough - LBSM (result, k) = runPut liftIO outputBuf outputBS put buf0 - -- convert a buffer to a lazy bytestring continuation - bufToLBSCont = maybe id L.Chunk . unsafeFreezeNonEmptyBuffer - -- lifting an io putsignal to a lazy bytestring monad - liftIO io = LBSM (S.inlinePerformIO io, id) - -- add buffer as a chunk prepare allocation of new one - outputBuf minSize buf = LBSM - ( S.inlinePerformIO $ allocBuffer (max minSize defaultBufferSize) - , bufToLBSCont buf ) - -- add bytestring directly as a chunk; exploits postcondition of runPut - -- that bytestrings are non-empty - outputBS bs = LBSM ((), L.Chunk bs) - - -{- --- | A Builder that traces a message -traceBuilder :: String -> Builder -traceBuilder msg = fromBuildStepCont $ \k br@(BufRange op ope) -> do - putStrLn $ "traceBuilder " ++ show (op, ope) ++ ": " ++ msg - k br - -test2 :: Word8 -> [S.ByteString] -test2 x = L.toChunks $ toLazyByteString2 $ fromBuilder $ mconcat - [ traceBuilder "before flush" - , fromWord8 48 - , flushBuilder - , flushBuilder - , traceBuilder "after flush" - , fromWord8 x - ] - --} - --} diff --git a/Blaze/ByteString/Builder/Internal/Buffer.hs b/Blaze/ByteString/Builder/Internal/Buffer.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/Buffer.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, Rank2Types #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - --- | --- Module : Blaze.ByteString.Builder.Internal.Buffer --- Copyright : (c) 2010 Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only --- --- Execution of the 'Put' monad and hence also 'Builder's with respect to --- buffers. --- -module Blaze.ByteString.Builder.Internal.Buffer ( - -- * Buffers - Buffer (..) - - -- ** Status information - , freeSize - , sliceSize - , bufferSize - - -- ** Creation and modification - , allocBuffer - , reuseBuffer - , nextSlice - , updateEndOfSlice - , execBuildStep - - -- ** Conversion to bytestings - , unsafeFreezeBuffer - , unsafeFreezeNonEmptyBuffer - - -- * Buffer allocation strategies - , BufferAllocStrategy - , allNewBuffersStrategy - , reuseBufferStrategy - - -- * Executing puts respect to some monad - , runPut - ) where - -#ifdef HAS_FOREIGN_UNSAFE_MODULE -import Foreign (Word8, ForeignPtr, Ptr, plusPtr, minusPtr) -import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) -#else -import Foreign (unsafeForeignPtrToPtr, Word8, ForeignPtr, Ptr, plusPtr, minusPtr) -#endif - -import qualified Data.ByteString as S - -#ifdef BYTESTRING_IN_BASE -import qualified Data.ByteString.Base as S -#else -import qualified Data.ByteString.Internal as S -#endif - -import Blaze.ByteString.Builder.Internal.Types ------------------------------------------------------------------------------- --- Buffers ------------------------------------------------------------------------------- - --- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying --- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free --- space @op..ope@. -data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array - {-# UNPACK #-} !(Ptr Word8) -- beginning of slice - {-# UNPACK #-} !(Ptr Word8) -- next free byte - {-# UNPACK #-} !(Ptr Word8) -- first byte after buffer - --- | The size of the free space of the buffer. -freeSize :: Buffer -> Int -freeSize (Buffer _ _ op ope) = ope `minusPtr` op - --- | The size of the written slice in the buffer. -sliceSize :: Buffer -> Int -sliceSize (Buffer _ p0 op _) = op `minusPtr` p0 - --- | The size of the whole byte array underlying the buffer. -bufferSize :: Buffer -> Int -bufferSize (Buffer fpbuf _ _ ope) = - ope `minusPtr` unsafeForeignPtrToPtr fpbuf - --- | @allocBuffer size@ allocates a new buffer of size @size@. -{-# INLINE allocBuffer #-} -allocBuffer :: Int -> IO Buffer -allocBuffer size = do - fpbuf <- S.mallocByteString size - let !pbuf = unsafeForeignPtrToPtr fpbuf - return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size) - --- | Resets the beginning of the next slice and the next free byte such that --- the whole buffer can be filled again. -{-# INLINE reuseBuffer #-} -reuseBuffer :: Buffer -> Buffer -reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope - where - p0 = unsafeForeignPtrToPtr fpbuf - --- | Convert the buffer to a bytestring. This operation is unsafe in the sense --- that created bytestring shares the underlying byte array with the buffer. --- Hence, depending on the later use of this buffer (e.g., if it gets reset and --- filled again) referential transparency may be lost. -{-# INLINE unsafeFreezeBuffer #-} -unsafeFreezeBuffer :: Buffer -> S.ByteString -unsafeFreezeBuffer (Buffer fpbuf p0 op _) = - S.PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0) - --- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for --- the explanation of why this operation may be unsafe. -{-# INLINE unsafeFreezeNonEmptyBuffer #-} -unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString -unsafeFreezeNonEmptyBuffer buf - | sliceSize buf <= 0 = Nothing - | otherwise = Just $ unsafeFreezeBuffer buf - --- | Update the end of slice pointer. -{-# INLINE updateEndOfSlice #-} -updateEndOfSlice :: Buffer -- Old buffer - -> Ptr Word8 -- New end of slice - -> Buffer -- Updated buffer -updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope - --- | Execute a build step on the given buffer. -{-# INLINE execBuildStep #-} -execBuildStep :: BuildStep a - -> Buffer - -> IO (BuildSignal a) -execBuildStep step (Buffer _ _ op ope) = runBuildStep step (BufRange op ope) - --- | Move the beginning of the slice to the next free byte such that the --- remaining free space of the buffer can be filled further. This operation --- is safe and can be used to fill the remaining part of the buffer after a --- direct insertion of a bytestring or a flush. -{-# INLINE nextSlice #-} -nextSlice :: Int -> Buffer -> Maybe Buffer -nextSlice minSize (Buffer fpbuf _ op ope) - | ope `minusPtr` op <= minSize = Nothing - | otherwise = Just (Buffer fpbuf op op ope) - ------------------------------------------------------------------------------- --- Buffer allocation strategies ------------------------------------------------------------------------------- - --- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial --- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at --- least size @minSize@ from a filled buffer @buf@. The double nesting of the --- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is --- lost as soon as possible, but the new buffer doesn't have to be allocated --- too early. -type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer)) - --- | The simplest buffer allocation strategy: whenever a buffer is requested, --- allocate a new one that is big enough for the next build step to execute. --- --- NOTE that this allocation strategy may spill quite some memory upon direct --- insertion of a bytestring by the builder. Thats no problem for garbage --- collection, but it may lead to unreasonably high memory consumption in --- special circumstances. -allNewBuffersStrategy :: Int -- Minimal buffer size. - -> BufferAllocStrategy -allNewBuffersStrategy bufSize = - ( allocBuffer bufSize - , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) ) - --- | An unsafe, but possibly more efficient buffer allocation strategy: --- reuse the buffer, if it is big enough for the next build step to execute. -reuseBufferStrategy :: IO Buffer - -> BufferAllocStrategy -reuseBufferStrategy buf0 = - (buf0, tryReuseBuffer) - where - tryReuseBuffer reqSize buf - | bufferSize buf >= reqSize = return $ return (reuseBuffer buf) - | otherwise = return $ allocBuffer reqSize - ------------------------------------------------------------------------------- --- Executing puts on a buffer ------------------------------------------------------------------------------- - - --- | Execute a put on a buffer. --- --- TODO: Generalize over buffer allocation strategy. -{-# INLINE runPut #-} -runPut :: Monad m - => (IO (BuildSignal a) -> m (BuildSignal a)) -- lifting of buildsteps - -> (Int -> Buffer -> m Buffer) -- output function for a guaranteedly non-empty buffer, the returned buffer will be filled next - -> (S.ByteString -> m ()) -- output function for guaranteedly non-empty bytestrings, that are inserted directly into the stream - -> Put a -- put to execute - -> Buffer -- initial buffer to be used - -> m (a, Buffer) -- result of put and remaining buffer -runPut liftIO outputBuf outputBS (Put put) = - runStep (put (finalStep)) - where - finalStep x = buildStep $ \(BufRange op _) -> return $ Done op x - - runStep step buf@(Buffer fpbuf p0 op ope) = do - let !br = BufRange op ope - signal <- liftIO $ runBuildStep step br - case signal of - Done op' x -> -- put completed, buffer partially runSteped - return (x, Buffer fpbuf p0 op' ope) - - BufferFull minSize op' nextStep -> do - buf' <- outputBuf minSize (Buffer fpbuf p0 op' ope) - runStep nextStep buf' - - InsertByteString op' bs nextStep - | S.null bs -> -- flushing of buffer required - outputBuf 1 (Buffer fpbuf p0 op' ope) >>= runStep nextStep - | p0 == op' -> do -- no bytes written: just insert bytestring - outputBS bs - runStep nextStep buf - | otherwise -> do -- bytes written, insert buffer and bytestring - buf' <- outputBuf 1 (Buffer fpbuf p0 op' ope) - outputBS bs - runStep nextStep buf' diff --git a/Blaze/ByteString/Builder/Internal/Types.hs b/Blaze/ByteString/Builder/Internal/Types.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/Types.hs +++ /dev/null @@ -1,144 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, Rank2Types #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - --- | --- Module : Blaze.ByteString.Builder.Internal.Types --- Copyright : (c) 2010 Simon Meier --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only --- --- Core types and functions for the 'Builder' monoid and the 'Put' monad based --- based on the 'blaze-builder' library by Jasper van der Jeugt and Simon --- Meier. --- -module Blaze.ByteString.Builder.Internal.Types where - -import Control.Applicative - -import Data.Monoid -import qualified Data.ByteString as S - -import Foreign - ------------------------------------------------------------------------------- --- The core: BuildSteps ------------------------------------------------------------------------------- - -data BufRange = BufRange {-# UNPACK #-} !(Ptr Word8) {-# UNPACK #-} !(Ptr Word8) - -data BuildSignal a = - Done {-# UNPACK #-} !(Ptr Word8) a - | BufferFull - {-# UNPACK #-} !Int - {-# UNPACK #-} !(Ptr Word8) - !(BuildStep a) - | InsertByteString - {-# UNPACK #-} !(Ptr Word8) - !S.ByteString - !(BuildStep a) - -newtype BuildStep a = - BuildStep { runBuildStep :: BufRange -> IO (BuildSignal a) } - --- Hiding the implementation of 'BuildStep's - -done :: Ptr Word8 -> a -> BuildSignal a -done = Done - -bufferFull :: Int -> Ptr Word8 -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a -bufferFull size op step = BufferFull size op (buildStep step) - -insertByteString :: Ptr Word8 -> S.ByteString -> (BufRange -> IO (BuildSignal a)) -> BuildSignal a -insertByteString op bs step = InsertByteString op bs (buildStep step) - -buildStep :: (BufRange -> IO (BuildSignal a)) -> BuildStep a -buildStep = BuildStep - ------------------------------------------------------------------------------- --- The 'Builder' Monoid and the 'Put' Monad ------------------------------------------------------------------------------- - -newtype Builder = Builder { - unBuilder :: forall r. BuildStep r -> BuildStep r - } - -instance Monoid Builder where - mempty = Builder id - {-# INLINE mempty #-} - (Builder b1) `mappend` (Builder b2) = Builder $ b1 . b2 - {-# INLINE mappend #-} - mconcat = foldr mappend mempty - {-# INLINE mconcat #-} - -newtype Put a = Put { - unPut :: forall r. (a -> BuildStep r) -> BuildStep r - } - -instance Functor Put where - fmap f (Put put) = Put $ \k -> put (\x -> k (f x)) - {-# INLINE fmap #-} - -instance Applicative Put where - pure x = Put $ \k -> k x - {-# INLINE pure #-} - f <*> a = Put $ \k -> unPut f (\f' -> unPut a (\a' -> k (f' a'))) - {-# INLINE (<*>) #-} - a <* b = Put $ \k -> unPut a (\a' -> unPut b (\_ -> k a')) - {-# INLINE (<*) #-} - a *> b = Put $ \k -> unPut a (\_ -> unPut b k) - {-# INLINE (*>) #-} - -instance Monad Put where - return x = Put $ \k -> k x - {-# INLINE return #-} - m >>= f = Put $ \k -> unPut m (\m' -> unPut (f m') k) - {-# INLINE (>>=) #-} - m >> n = Put $ \k -> unPut m (\_ -> unPut n k) - {-# INLINE (>>) #-} - - --- Creation from concrete 'BuildStep's ------------------------------------------------------------------------------- - -putBuildStepCont :: (forall r. (a -> BufRange -> IO (BuildSignal r)) -> - ( BufRange -> IO (BuildSignal r)) - ) -> Put a -putBuildStepCont step = Put step' - where - step' k = BuildStep $ step (\x -> runBuildStep (k x)) - - -fromBuildStepCont :: (forall r. (BufRange -> IO (BuildSignal r)) -> - (BufRange -> IO (BuildSignal r)) - ) -> Builder -fromBuildStepCont step = Builder step' - where - step' k = BuildStep $ step (runBuildStep k) - - - --- Conversion between Put and Builder ------------------------------------------------------------------------------- - --- | Put the given builder. -putBuilder :: Builder -> Put () -putBuilder (Builder build) = Put $ \k -> build (k ()) - - --- | Ignore the value of a put and only exploit its output side effect. -fromPut :: Put a -> Builder -fromPut (Put put) = Builder $ \k -> put (\_ -> k) - --- Lifting IO actions ---------------------- - --- | Lift the given IO action. -{-# INLINE putLiftIO #-} -putLiftIO :: IO a -> Put a -putLiftIO io = putBuildStepCont $ \k br -> io >>= (`k` br) diff --git a/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs b/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs deleted file mode 100644 --- a/Blaze/ByteString/Builder/Internal/UncheckedShifts.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE CPP, MagicHash #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - --- | --- Module : Blaze.ByteString.Builder.Internal.UncheckedShifts --- Copyright : (c) 2010 Simon Meier --- --- Original serialization code from 'Data.Binary.Builder': --- (c) Lennart Kolmodin, Ross Patterson --- --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only --- --- Utilty module defining unchecked shifts. --- -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -#include "MachDeps.h" -#endif - -module Blaze.ByteString.Builder.Internal.UncheckedShifts ( - shiftr_w16 - , shiftr_w32 - , shiftr_w64 - ) where - --- TODO: Check validity of this implementation - -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -import GHC.Base -import GHC.Word (Word32(..),Word16(..),Word64(..)) - -#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608 -import GHC.Word (uncheckedShiftRL64#) -#endif -#else -import Data.Word -#endif - - ------------------------------------------------------------------------- --- Unchecked shifts - -{-# INLINE shiftr_w16 #-} -shiftr_w16 :: Word16 -> Int -> Word16 -{-# INLINE shiftr_w32 #-} -shiftr_w32 :: Word32 -> Int -> Word32 -{-# INLINE shiftr_w64 #-} -shiftr_w64 :: Word64 -> Int -> Word64 - -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i) -shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i) - -#if WORD_SIZE_IN_BITS < 64 -shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i) - -#if __GLASGOW_HASKELL__ <= 606 --- Exported by GHC.Word in GHC 6.8 and higher -foreign import ccall unsafe "stg_uncheckedShiftRL64" - uncheckedShiftRL64# :: Word64# -> Int# -> Word64# -#endif - -#else -shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i) -#endif - -#else -shiftr_w16 = shiftR -shiftr_w32 = shiftR -shiftr_w64 = shiftR -#endif - diff --git a/Blaze/ByteString/Builder/Internal/Write.hs b/Blaze/ByteString/Builder/Internal/Write.hs --- a/Blaze/ByteString/Builder/Internal/Write.hs +++ b/Blaze/ByteString/Builder/Internal/Write.hs @@ -1,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 +-- Maintainer : Leon Smith -- 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 diff --git a/Blaze/ByteString/Builder/Word.hs b/Blaze/ByteString/Builder/Word.hs --- a/Blaze/ByteString/Builder/Word.hs +++ b/Blaze/ByteString/Builder/Word.hs @@ -1,21 +1,10 @@ -{-# LANGUAGE CPP #-} - -#ifdef USE_MONO_PAT_BINDS -{-# LANGUAGE MonoPatBinds #-} -#endif - +------------------------------------------------------------------------------ -- | --- Module : Blaze.ByteString.Builder.Word --- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier --- --- Original serialization code from 'Data.Binary.Builder': --- (c) Lennart Kolmodin, Ross Patterson --- --- License : BSD3-style (see LICENSE) --- --- Maintainer : Simon Meier --- Stability : experimental --- Portability : tested on GHC only +-- Module: Blaze.ByteString.Builder.Word +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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 #-} diff --git a/benchmarks/BenchThroughput.hs b/benchmarks/BenchThroughput.hs --- a/benchmarks/BenchThroughput.hs +++ b/benchmarks/BenchThroughput.hs @@ -4,7 +4,7 @@ -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : GHC -- diff --git a/benchmarks/BlazeVsBinary.hs b/benchmarks/BlazeVsBinary.hs --- a/benchmarks/BlazeVsBinary.hs +++ b/benchmarks/BlazeVsBinary.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Jasper Van der Jeught & Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/BoundedWrite.hs b/benchmarks/BoundedWrite.hs --- a/benchmarks/BoundedWrite.hs +++ b/benchmarks/BoundedWrite.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/BuilderBufferRange.hs b/benchmarks/BuilderBufferRange.hs --- a/benchmarks/BuilderBufferRange.hs +++ b/benchmarks/BuilderBufferRange.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/ChunkedWrite.hs b/benchmarks/ChunkedWrite.hs --- a/benchmarks/ChunkedWrite.hs +++ b/benchmarks/ChunkedWrite.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/Compression.hs b/benchmarks/Compression.hs --- a/benchmarks/Compression.hs +++ b/benchmarks/Compression.hs @@ -3,7 +3,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/FastPut.hs b/benchmarks/FastPut.hs --- a/benchmarks/FastPut.hs +++ b/benchmarks/FastPut.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/LazyByteString.hs b/benchmarks/LazyByteString.hs --- a/benchmarks/LazyByteString.hs +++ b/benchmarks/LazyByteString.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/PlotTest.hs b/benchmarks/PlotTest.hs --- a/benchmarks/PlotTest.hs +++ b/benchmarks/PlotTest.hs @@ -4,7 +4,7 @@ -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : GHC -- diff --git a/benchmarks/StringAndText.hs b/benchmarks/StringAndText.hs --- a/benchmarks/StringAndText.hs +++ b/benchmarks/StringAndText.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/UnboxedAppend.hs b/benchmarks/UnboxedAppend.hs --- a/benchmarks/UnboxedAppend.hs +++ b/benchmarks/UnboxedAppend.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2010 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/benchmarks/Utf8IO.hs b/benchmarks/Utf8IO.hs --- a/benchmarks/Utf8IO.hs +++ b/benchmarks/Utf8IO.hs @@ -3,7 +3,7 @@ -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) -- --- Maintainer : Simon Meier +-- Maintainer : Leon P Smith -- Stability : experimental -- Portability : tested on GHC only -- diff --git a/blaze-builder.cabal b/blaze-builder.cabal --- a/blaze-builder.cabal +++ b/blaze-builder.cabal @@ -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 +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 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 diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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)