diff --git a/Data/ByteString/Builder.hs b/Data/ByteString/Builder.hs index 35e376cb0..09c85b210 100644 --- a/Data/ByteString/Builder.hs +++ b/Data/ByteString/Builder.hs @@ -26,10 +26,10 @@ For an /efficient implementation of an encoding/, 'Builder's support (a) by providing an /O(1)/ concatentation operation and efficient implementations of basic encodings for 'Char's, 'Int's, and other standard Haskell values. -They support (b) by providing their result as a lazy 'L.ByteString', +They support (b) by providing their result as a 'L.LazyByteString', which is internally just a linked list of pointers to /chunks/ of consecutive raw memory. -Lazy 'L.ByteString's can be efficiently consumed by functions that +'L.LazyByteString's can be efficiently consumed by functions that write them to a file or send them over a network socket. Note that each chunk boundary incurs expensive extra work (e.g., a system call) that must be amortized over the work spent on consuming the chunk body. @@ -65,11 +65,11 @@ using some Unicode character encoding. However, this sacrifices performance due to the intermediate 'String' representation being built and thrown away right afterwards. We get rid of this intermediate 'String' representation by fixing the character encoding to UTF-8 and using 'Builder's to convert -@Table@s directly to UTF-8 encoded CSV tables represented as lazy -'L.ByteString's. +@Table@s directly to UTF-8 encoded CSV tables represented as +'L.LazyByteString's. @ -encodeUtf8CSV :: Table -> L.ByteString +encodeUtf8CSV :: Table -> L.LazyByteString encodeUtf8CSV = 'toLazyByteString' . renderTable renderTable :: Table -> Builder @@ -114,7 +114,7 @@ table = [map StringC strings, map IntC [-3..3]] @ The expression @encodeUtf8CSV table@ results in the following lazy -'L.ByteString'. +'L.LazyByteString'. >Chunk "\"hello\",\"\\\"1\\\"\",\"\206\187-w\195\182rld\"\n-3,-2,-1,0,1,2,3\n" Empty @@ -137,7 +137,7 @@ We use the @criterion@ library () > ] On a Core2 Duo 2.20GHz on a 32-bit Linux, - the above code takes 1ms to generate the 22'500 bytes long lazy 'L.ByteString'. + the above code takes 1ms to generate the 22'500 bytes long 'L.LazyByteString'. Looking again at the definitions above, we see that we took care to avoid intermediate data structures, as otherwise we would sacrifice performance. @@ -148,7 +148,7 @@ For example, >renderRow = mconcat . intersperse (charUtf8 ',') . map renderCell Similarly, using /O(n)/ concatentations like '++' or the equivalent 'Data.ByteString.concat' - operations on strict and lazy 'L.ByteString's should be avoided. + operations on strict and 'L.LazyByteString's should be avoided. The following definition of @renderString@ is also about 20% slower. >renderString :: String -> Builder @@ -264,11 +264,11 @@ import Foreign import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build) --- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'. --- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString' +-- | Execute a 'Builder' and return the generated chunks as a 'L.LazyByteString'. +-- The work is performed lazy, i.e., only when a chunk of the 'L.LazyByteString' -- is forced. {-# NOINLINE toLazyByteString #-} -- ensure code is shared -toLazyByteString :: Builder -> L.ByteString +toLazyByteString :: Builder -> L.LazyByteString toLazyByteString = toLazyByteStringWith (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty diff --git a/Data/ByteString/Builder/ASCII.hs b/Data/ByteString/Builder/ASCII.hs index 694b5c8f5..0d780c073 100644 --- a/Data/ByteString/Builder/ASCII.hs +++ b/Data/ByteString/Builder/ASCII.hs @@ -240,14 +240,14 @@ floatHexFixed = P.primFixed P.floatHexFixed doubleHexFixed :: Double -> Builder doubleHexFixed = P.primFixed P.doubleHexFixed --- | Encode each byte of a 'S.ByteString' using its fixed-width hex encoding. +-- | Encode each byte of a 'S.StrictByteString' using its fixed-width hex encoding. {-# NOINLINE byteStringHex #-} -- share code -byteStringHex :: S.ByteString -> Builder +byteStringHex :: S.StrictByteString -> Builder byteStringHex = P.primMapByteStringFixed P.word8HexFixed --- | Encode each byte of a lazy 'L.ByteString' using its fixed-width hex encoding. +-- | Encode each byte of a 'L.LazyByteString' using its fixed-width hex encoding. {-# NOINLINE lazyByteStringHex #-} -- share code -lazyByteStringHex :: L.ByteString -> Builder +lazyByteStringHex :: L.LazyByteString -> Builder lazyByteStringHex = P.primMapLazyByteStringFixed P.word8HexFixed diff --git a/Data/ByteString/Builder/Extra.hs b/Data/ByteString/Builder/Extra.hs index 785fd8dfe..c157df457 100644 --- a/Data/ByteString/Builder/Extra.hs +++ b/Data/ByteString/Builder/Extra.hs @@ -78,7 +78,7 @@ import Foreign -- * an IO action for writing the Builder's data into a user-supplied memory -- buffer. -- --- * a pre-existing chunks of data represented by a strict 'S.ByteString' +-- * a pre-existing chunks of data represented by a 'S.StrictByteString' -- -- While this is rather low level, it provides you with full flexibility in -- how the data is written out. @@ -107,10 +107,10 @@ data Next = -- | In addition to the data that has just been written into your buffer -- by the 'BufferWriter' action, it gives you a pre-existing chunk - -- of data as a 'S.ByteString'. It also gives you the following 'BufferWriter' + -- of data as a 'S.StrictByteString'. It also gives you the following 'BufferWriter' -- action. It is safe to run this following action using a buffer with as -- much free space as was left by the previous run action. - | Chunk !S.ByteString BufferWriter + | Chunk !S.StrictByteString BufferWriter -- | Turn a 'Builder' into its initial 'BufferWriter' action. -- diff --git a/Data/ByteString/Builder/Internal.hs b/Data/ByteString/Builder/Internal.hs index e6c8174d0..00cbedce4 100644 --- a/Data/ByteString/Builder/Internal.hs +++ b/Data/ByteString/Builder/Internal.hs @@ -173,17 +173,17 @@ newBuffer size = do let pbuf = unsafeForeignPtrToPtr fpbuf return $! Buffer fpbuf (BufferRange pbuf (pbuf `plusPtr` size)) --- | Convert the filled part of a 'Buffer' to a strict 'S.ByteString'. +-- | Convert the filled part of a 'Buffer' to a 'S.StrictByteString'. {-# INLINE byteStringFromBuffer #-} -byteStringFromBuffer :: Buffer -> S.ByteString +byteStringFromBuffer :: Buffer -> S.StrictByteString byteStringFromBuffer (Buffer fpbuf (BufferRange op _)) = S.BS fpbuf (op `minusPtr` unsafeForeignPtrToPtr fpbuf) --- | Prepend the filled part of a 'Buffer' to a lazy 'L.ByteString' +-- | Prepend the filled part of a 'Buffer' to a 'L.LazyByteString' -- trimming it if necessary. {-# INLINE trimmedChunkFromBuffer #-} trimmedChunkFromBuffer :: AllocationStrategy -> Buffer - -> L.ByteString -> L.ByteString + -> L.LazyByteString -> L.LazyByteString trimmedChunkFromBuffer (AllocationStrategy _ _ trim) buf k | S.null bs = k | trim (S.length bs) (bufferSize buf) = L.Chunk (S.copy bs) k @@ -204,33 +204,33 @@ trimmedChunkFromBuffer (AllocationStrategy _ _ trim) buf k data ChunkIOStream a = Finished Buffer a -- ^ The partially filled last buffer together with the result. - | Yield1 S.ByteString (IO (ChunkIOStream a)) - -- ^ Yield a /non-empty/ strict 'S.ByteString'. + | Yield1 S.StrictByteString (IO (ChunkIOStream a)) + -- ^ Yield a /non-empty/ 'S.StrictByteString'. -- | A smart constructor for yielding one chunk that ignores the chunk if -- it is empty. {-# INLINE yield1 #-} -yield1 :: S.ByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a) +yield1 :: S.StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a) yield1 bs cios | S.null bs = cios | otherwise = return $ Yield1 bs cios --- | Convert a @'ChunkIOStream' ()@ to a lazy 'L.ByteString' using +-- | Convert a @'ChunkIOStream' ()@ to a 'L.LazyByteString' using -- 'unsafeDupablePerformIO'. {-# INLINE ciosUnitToLazyByteString #-} ciosUnitToLazyByteString :: AllocationStrategy - -> L.ByteString -> ChunkIOStream () -> L.ByteString + -> L.LazyByteString -> ChunkIOStream () -> L.LazyByteString ciosUnitToLazyByteString strategy k = go where go (Finished buf _) = trimmedChunkFromBuffer strategy buf k go (Yield1 bs io) = L.Chunk bs $ unsafeDupablePerformIO (go <$> io) -- | Convert a 'ChunkIOStream' to a lazy tuple of the result and the written --- 'L.ByteString' using 'unsafeDupablePerformIO'. +-- 'L.LazyByteString' using 'unsafeDupablePerformIO'. {-# INLINE ciosToLazyByteString #-} ciosToLazyByteString :: AllocationStrategy - -> (a -> (b, L.ByteString)) + -> (a -> (b, L.LazyByteString)) -> ChunkIOStream a - -> (b, L.ByteString) + -> (b, L.LazyByteString) ciosToLazyByteString strategy k = go where @@ -256,7 +256,7 @@ data BuildSignal a = (BuildStep a) | InsertChunk {-# UNPACK #-} !(Ptr Word8) - S.ByteString + S.StrictByteString (BuildStep a) -- | Signal that the current 'BuildStep' is done and has computed a value. @@ -281,11 +281,11 @@ bufferFull :: Int bufferFull = BufferFull --- | Signal that a 'S.ByteString' chunk should be inserted directly. +-- | Signal that a 'S.StrictByteString' chunk should be inserted directly. {-# INLINE insertChunk #-} insertChunk :: Ptr Word8 -- ^ Next free byte in current 'BufferRange' - -> S.ByteString + -> S.StrictByteString -- ^ Chunk to insert. -> BuildStep a -- ^ 'BuildStep' to run on next 'BufferRange' @@ -302,7 +302,7 @@ fillWithBuildStep -- ^ Handling the 'done' signal -> (Ptr Word8 -> Int -> BuildStep a -> IO b) -- ^ Handling the 'bufferFull' signal - -> (Ptr Word8 -> S.ByteString -> BuildStep a -> IO b) + -> (Ptr Word8 -> S.StrictByteString -> BuildStep a -> IO b) -- ^ Handling the 'insertChunk' signal -> BufferRange -- ^ Buffer range to fill. @@ -697,7 +697,7 @@ hPut h p = do fillHandle 1 nextStep -- | Execute a 'Put' and return the computed result and the bytes --- written during the computation as a lazy 'L.ByteString'. +-- written during the computation as a 'L.LazyByteString'. -- -- This function is strict in the computed result and lazy in the writing of -- the bytes. For example, given @@ -726,15 +726,15 @@ hPut h p = do -- @ --type DecodingState = ... -- ---decodeBase64 :: 'S.ByteString' -> DecodingState -> 'Put' (Maybe DecodingState) +--decodeBase64 :: 'S.StrictByteString' -> DecodingState -> 'Put' (Maybe DecodingState) --decodeBase64 = ... -- @ -- --- The above function takes a strict 'S.ByteString' supposed to represent +-- The above function takes a 'S.StrictByteString' supposed to represent -- Base64 encoded data and the current decoding state. -- It writes the decoded bytes as the side-effect of the 'Put' and returns the --- new decoding state, if the decoding of all data in the 'S.ByteString' was --- successful. The checking if the strict 'S.ByteString' represents Base64 +-- new decoding state, if the decoding of all data in the 'S.StrictByteString' was +-- successful. The checking if the 'S.StrictByteString' represents Base64 -- encoded data and the actual decoding are fused. This makes the common case, -- where all data represents Base64 encoded data, more efficient. It also -- implies that all data must be decoded before the final decoding @@ -744,7 +744,7 @@ hPut h p = do {-# NOINLINE putToLazyByteString #-} putToLazyByteString :: Put a -- ^ 'Put' to execute - -> (a, L.ByteString) -- ^ Result and lazy 'L.ByteString' + -> (a, L.LazyByteString) -- ^ Result and 'L.LazyByteString' -- written as its side-effect putToLazyByteString = putToLazyByteStringWith (safeStrategy L.smallChunkSize L.defaultChunkSize) (, L.Empty) @@ -762,13 +762,13 @@ putToLazyByteString = putToLazyByteStringWith putToLazyByteStringWith :: AllocationStrategy -- ^ Buffer allocation strategy to use - -> (a -> (b, L.ByteString)) + -> (a -> (b, L.LazyByteString)) -- ^ Continuation to use for computing the final result and the tail of -- its side-effect (the written bytes). -> Put a -- ^ 'Put' to execute - -> (b, L.ByteString) - -- ^ Resulting lazy 'L.ByteString' + -> (b, L.LazyByteString) + -- ^ Resulting 'L.LazyByteString' putToLazyByteStringWith strategy k p = ciosToLazyByteString strategy k $ unsafeDupablePerformIO $ buildStepToCIOS strategy (runPut p) @@ -817,17 +817,17 @@ wrappedBytesCopyStep (BufferRange ip0 ipe) k = ------------------------------------------------------------------------------ --- | Construct a 'Builder' that copies the strict 'S.ByteString's, if it is +-- | Construct a 'Builder' that copies the 'S.StrictByteString's, if it is -- smaller than the treshold, and inserts it directly otherwise. -- --- For example, @byteStringThreshold 1024@ copies strict 'S.ByteString's whose size +-- For example, @byteStringThreshold 1024@ copies 'S.StrictByteString'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 +-- that the average chunk-size of the generated 'L.LazyByteString' 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. +-- directly inserted 1025 byte, 'S.StrictByteString's. -- {-# INLINE byteStringThreshold #-} -byteStringThreshold :: Int -> S.ByteString -> Builder +byteStringThreshold :: Int -> S.StrictByteString -> Builder byteStringThreshold maxCopySize = \bs -> builder $ step bs where @@ -835,18 +835,18 @@ byteStringThreshold maxCopySize = | len <= maxCopySize = byteStringCopyStep bs k br | otherwise = return $ insertChunk op bs k --- | Construct a 'Builder' that copies the strict 'S.ByteString'. +-- | Construct a 'Builder' that copies the 'S.StrictByteString'. -- -- Use this function to create 'Builder's from smallish (@<= 4kb@) --- 'S.ByteString's or if you need to guarantee that the 'S.ByteString' is not +-- 'S.StrictByteString's or if you need to guarantee that the 'S.StrictByteString' is not -- shared with the chunks generated by the 'Builder'. -- {-# INLINE byteStringCopy #-} -byteStringCopy :: S.ByteString -> Builder +byteStringCopy :: S.StrictByteString -> Builder byteStringCopy = \bs -> builder $ byteStringCopyStep bs {-# INLINE byteStringCopyStep #-} -byteStringCopyStep :: S.ByteString -> BuildStep a -> BuildStep a +byteStringCopyStep :: S.StrictByteString -> BuildStep a -> BuildStep a byteStringCopyStep (S.BS ifp isize) !k0 br0@(BufferRange op ope) -- Ensure that the common case is not recursive and therefore yields -- better code. @@ -861,16 +861,16 @@ byteStringCopyStep (S.BS ifp isize) !k0 br0@(BufferRange op ope) k br = do touchForeignPtr ifp -- input consumed: OK to release here k0 br --- | Construct a 'Builder' that always inserts the strict 'S.ByteString' +-- | Construct a 'Builder' that always inserts the 'S.StrictByteString' -- directly as a chunk. -- -- This implies flushing the output buffer, even if it contains just -- a single byte. You should therefore use 'byteStringInsert' only for large --- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too +-- (@> 8kb@) 'S.StrictByteString's. Otherwise, the generated chunks are too -- fragmented to be processed efficiently afterwards. -- {-# INLINE byteStringInsert #-} -byteStringInsert :: S.ByteString -> Builder +byteStringInsert :: S.StrictByteString -> Builder byteStringInsert = \bs -> builder $ \k (BufferRange op _) -> return $ insertChunk op bs k @@ -908,47 +908,47 @@ shortByteStringCopyStep !sbs k = ------------------------------------------------------------------------------ -- | Construct a 'Builder' that uses the thresholding strategy of 'byteStringThreshold' --- for each chunk of the lazy 'L.ByteString'. +-- for each chunk of the 'L.LazyByteString'. -- {-# INLINE lazyByteStringThreshold #-} -lazyByteStringThreshold :: Int -> L.ByteString -> Builder +lazyByteStringThreshold :: Int -> L.LazyByteString -> Builder lazyByteStringThreshold maxCopySize = L.foldrChunks (\bs b -> byteStringThreshold maxCopySize bs `mappend` b) mempty -- TODO: We could do better here. Currently, Large, Small, Large, leads to -- an unnecessary copy of the 'Small' chunk. --- | Construct a 'Builder' that copies the lazy 'L.ByteString'. +-- | Construct a 'Builder' that copies the 'L.LazyByteString'. -- {-# INLINE lazyByteStringCopy #-} -lazyByteStringCopy :: L.ByteString -> Builder +lazyByteStringCopy :: L.LazyByteString -> Builder lazyByteStringCopy = L.foldrChunks (\bs b -> byteStringCopy bs `mappend` b) mempty --- | Construct a 'Builder' that inserts all chunks of the lazy 'L.ByteString' +-- | Construct a 'Builder' that inserts all chunks of the 'L.LazyByteString' -- directly. -- {-# INLINE lazyByteStringInsert #-} -lazyByteStringInsert :: L.ByteString -> Builder +lazyByteStringInsert :: L.LazyByteString -> Builder lazyByteStringInsert = L.foldrChunks (\bs b -> byteStringInsert bs `mappend` b) mempty --- | Create a 'Builder' denoting the same sequence of bytes as a strict --- 'S.ByteString'. --- The 'Builder' inserts large 'S.ByteString's directly, but copies small ones +-- | Create a 'Builder' denoting the same sequence of bytes as a +-- 'S.StrictByteString'. +-- The 'Builder' inserts large 'S.StrictByteString's directly, but copies small ones -- to ensure that the generated chunks are large on average. -- {-# INLINE byteString #-} -byteString :: S.ByteString -> Builder +byteString :: S.StrictByteString -> Builder byteString = byteStringThreshold maximalCopySize -- | Create a 'Builder' denoting the same sequence of bytes as a lazy --- 'L.ByteString'. --- The 'Builder' inserts large chunks of the lazy 'L.ByteString' directly, +-- 'L.LazyByteString'. +-- The 'Builder' inserts large chunks of the 'L.LazyByteString' directly, -- but copies small ones to ensure that the generated chunks are large on -- average. -- {-# INLINE lazyByteString #-} -lazyByteString :: L.ByteString -> Builder +lazyByteString :: L.LazyByteString -> Builder lazyByteString = lazyByteStringThreshold maximalCopySize -- FIXME: also insert the small chunk for [large,small,large] directly. -- Perhaps it makes even sense to concatenate the small chunks in @@ -956,7 +956,7 @@ lazyByteString = lazyByteStringThreshold maximalCopySize -- unnecessary buffer spilling. Hmm, but that uncontrollably increases latency -- => no good! --- | The maximal size of a 'S.ByteString' that is copied. +-- | The maximal size of a 'S.StrictByteString' that is copied. -- @2 * 'L.smallChunkSize'@ to guarantee that on average a chunk is of -- 'L.smallChunkSize'. maximalCopySize :: Int @@ -1003,7 +1003,7 @@ customStrategy = AllocationStrategy sanitize :: Int -> Int sanitize = max (sizeOf (undefined :: Int)) --- | Use this strategy for generating lazy 'L.ByteString's whose chunks are +-- | Use this strategy for generating 'L.LazyByteString's whose chunks are -- discarded right after they are generated. For example, if you just generate -- them to write them to a network socket. {-# INLINE untrimmedStrategy #-} @@ -1020,7 +1020,7 @@ untrimmedStrategy firstSize bufSize = nextBuffer (Just (_, minSize)) = newBuffer minSize --- | Use this strategy for generating lazy 'L.ByteString's whose chunks are +-- | Use this strategy for generating 'L.LazyByteString's whose chunks are -- likely to survive one garbage collection. This strategy trims buffers -- that are filled less than half in order to avoid spilling too much memory. {-# INLINE safeStrategy #-} @@ -1049,7 +1049,7 @@ safeStrategy firstSize bufSize = -- toLazyByteStringWith ('safeStrategy' 'L.smallChunkSize' 'L.defaultChunkSize') L.empty -- @ -- --- where @L.empty@ is the zero-length lazy 'L.ByteString'. +-- where @L.empty@ is the zero-length 'L.LazyByteString'. -- -- In most cases, the parameters used by 'Data.ByteString.Builder.toLazyByteString' give good -- performance. A sub-performing case of 'Data.ByteString.Builder.toLazyByteString' is executing short @@ -1060,20 +1060,20 @@ safeStrategy firstSize bufSize = -- >toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty -- -- This reduces the allocation and trimming overhead, as all generated --- 'L.ByteString's fit into the first buffer and there is no trimming +-- 'L.LazyByteString's fit into the first buffer and there is no trimming -- required, if more than 64 bytes and less than 128 bytes are written. -- {-# INLINE toLazyByteStringWith #-} toLazyByteStringWith :: AllocationStrategy -- ^ Buffer allocation strategy to use - -> L.ByteString - -- ^ Lazy 'L.ByteString' to use as the tail of the generated lazy - -- 'L.ByteString' + -> L.LazyByteString + -- ^ 'L.LazyByteString' to use as the tail of the generated lazy + -- 'L.LazyByteString' -> Builder -- ^ 'Builder' to execute - -> L.ByteString - -- ^ Resulting lazy 'L.ByteString' + -> L.LazyByteString + -- ^ Resulting 'L.LazyByteString' toLazyByteStringWith strategy k b = ciosUnitToLazyByteString strategy k $ unsafeDupablePerformIO $ buildStepToCIOS strategy (runBuilder b) @@ -1107,7 +1107,7 @@ buildStepToCIOS (AllocationStrategy nextBuffer bufSize trim) = wrapChunk op' $ const $ nextBuffer (Just (buf, max minSize bufSize)) >>= fill nextStep - insertChunkH :: Ptr Word8 -> S.ByteString -> BuildStep a -> IO (ChunkIOStream a) + insertChunkH :: Ptr Word8 -> S.StrictByteString -> BuildStep a -> IO (ChunkIOStream a) insertChunkH op' bs nextStep = wrapChunk op' $ \isEmpty -> yield1 bs $ -- Checking for empty case avoids allocating 'n-1' empty diff --git a/Data/ByteString/Builder/Prim.hs b/Data/ByteString/Builder/Prim.hs index e08e69e03..a4bd22c77 100644 --- a/Data/ByteString/Builder/Prim.hs +++ b/Data/ByteString/Builder/Prim.hs @@ -269,9 +269,9 @@ corresponding functions in future releases of this library. -- > map :: (Word8 -> Word8) -> ByteString -> ByteString -- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f) -- --- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's, +-- Compared to earlier versions of @filter@ and @map@ on 'L.LazyByteString's, -- these versions use a more efficient inner loop and have the additional --- advantage that they always result in well-chunked 'L.ByteString's; i.e, they +-- advantage that they always result in well-chunked 'L.LazyByteString's; i.e, they -- also perform automatic defragmentation. -- -- We can also use 'E.Encoding's to improve the efficiency of the following @@ -398,7 +398,7 @@ module Data.ByteString.Builder.Prim ( -- which is implemented as follows. -- -- @ - -- byteStringHex :: S.ByteString -> Builder + -- byteStringHex :: S.StrictByteString -> Builder -- byteStringHex = 'primMapByteStringFixed' 'word8HexFixed' -- @ -- @@ -492,24 +492,24 @@ primMapListFixed = primMapListBounded . toB primUnfoldrFixed :: FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder primUnfoldrFixed = primUnfoldrBounded . toB --- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from +-- | /Heavy inlining./ Encode all bytes of a 'S.StrictByteString' from -- left-to-right with a 'FixedPrim'. This function is quite versatile. For -- example, we can use it to construct a 'Builder' that maps every byte before -- copying it to the buffer to be filled. -- --- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder +-- > mapToBuilder :: (Word8 -> Word8) -> S.StrictByteString -> Builder -- > mapToBuilder f = primMapByteStringFixed (contramapF f word8) -- --- We can also use it to hex-encode a strict 'S.ByteString' as shown by the +-- We can also use it to hex-encode a 'S.StrictByteString' as shown by the -- 'Data.ByteString.Builder.ASCII.byteStringHex' example above. {-# INLINE primMapByteStringFixed #-} -primMapByteStringFixed :: FixedPrim Word8 -> (S.ByteString -> Builder) +primMapByteStringFixed :: FixedPrim Word8 -> (S.StrictByteString -> Builder) primMapByteStringFixed = primMapByteStringBounded . toB --- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from +-- | /Heavy inlining./ Encode all bytes of a 'L.LazyByteString' from -- left-to-right with a 'FixedPrim'. {-# INLINE primMapLazyByteStringFixed #-} -primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.ByteString -> Builder) +primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.LazyByteString -> Builder) primMapLazyByteStringFixed = primMapLazyByteStringBounded . toB -- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build @@ -530,8 +530,8 @@ primMapLazyByteStringFixed = primMapLazyByteStringBounded . toB -- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This -- optimization is not observationally equivalent in a strict sense, as it -- influences the boundaries of the generated chunks. However, for a user of --- this library it is observationally equivalent, as chunk boundaries of a lazy --- 'L.ByteString' can only be observed through the internal interface. +-- this library it is observationally equivalent, as chunk boundaries of a +-- 'L.LazyByteString' can only be observed through the internal interface. -- Moreover, we expect that all primitives write much fewer than 4kb (the -- default short buffer size). Hence, it is safe to ignore the additional -- memory spilled due to the more aggressive buffer wrapping introduced by this @@ -615,16 +615,16 @@ primUnfoldrBounded w f x0 = fillWith x' k (BufferRange opNew' opeNew) bound = I.sizeBound w --- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString' +-- | Create a 'Builder' that encodes each 'Word8' of a 'S.StrictByteString' -- using a 'BoundedPrim'. For example, we can write a 'Builder' that filters --- a strict 'S.ByteString' as follows. +-- a 'S.StrictByteString' as follows. -- -- > import qualified Data.ByteString.Builder.Prim as P -- -- > filterBS p = P.condB p (P.liftFixedToBounded P.word8) P.emptyB -- {-# INLINE primMapByteStringBounded #-} -primMapByteStringBounded :: BoundedPrim Word8 -> S.ByteString -> Builder +primMapByteStringBounded :: BoundedPrim Word8 -> S.StrictByteString -> Builder primMapByteStringBounded w = \bs -> builder $ step bs where @@ -658,7 +658,7 @@ primMapByteStringBounded w = -- | Chunk-wise application of 'primMapByteStringBounded'. {-# INLINE primMapLazyByteStringBounded #-} -primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.ByteString -> Builder +primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.LazyByteString -> Builder primMapLazyByteStringBounded w = L.foldrChunks (\x b -> primMapByteStringBounded w x `mappend` b) mempty diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index ca34f1aa1..decd4a35b 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -274,12 +274,12 @@ pack = packBytes unpack :: ByteString -> [Word8] unpack = unpackBytes --- | /O(c)/ Convert a list of strict 'ByteString' into a lazy 'ByteString' -fromChunks :: [P.ByteString] -> ByteString +-- | /O(c)/ Convert a list of 'S.StrictByteString' into a 'LazyByteString' +fromChunks :: [S.StrictByteString] -> LazyByteString fromChunks = List.foldr chunk Empty --- | /O(c)/ Convert a lazy 'ByteString' into a list of strict 'ByteString' -toChunks :: ByteString -> [P.ByteString] +-- | /O(c)/ Convert a 'LazyByteString' into a list of 'S.StrictByteString' +toChunks :: LazyByteString -> [S.StrictByteString] toChunks = foldrChunks (:) [] ------------------------------------------------------------------------ @@ -845,7 +845,7 @@ dropEnd i p = go D.empty p getOutput (Chunk x out) deque' _ -> (reverseChunks out, deque) - -- reverse a `ByteString`s chunks, keeping all internal `S.ByteString`s + -- reverse a `ByteString`s chunks, keeping all internal `S.StrictByteString`s -- unchanged reverseChunks = foldlChunks (flip Chunk) empty @@ -1714,7 +1714,7 @@ revChunks = List.foldl' (flip chunk) Empty -- reading the whole file via 'readFile' executes all three actions -- (open the file handle, read its content, close the file handle) before -- control moves to the following 'writeFile' action. This expectation holds --- for the strict "Data.ByteString" API. However, the above lazy 'ByteString' variant +-- for the strict "Data.ByteString" API. However, the above 'LazyByteString' variant -- of the program fails with @openBinaryFile: resource busy (file is locked)@. -- -- The reason for this is that "Data.ByteString.Lazy" is specifically designed diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs index 9b3cd76ac..7607f166d 100644 --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -83,13 +83,13 @@ import Control.Exception (assert) -- | A space-efficient representation of a 'Word8' vector, supporting many -- efficient operations. -- --- A lazy 'ByteString' contains 8-bit bytes, or by using the operations +-- A 'LazyByteString' contains 8-bit bytes, or by using the operations -- from "Data.ByteString.Lazy.Char8" it can be interpreted as containing -- 8-bit characters. -- #ifndef HS_BYTESTRING_ASSERTIONS -data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString - -- INVARIANT: The S.ByteString field of any Chunk is not empty. +data ByteString = Empty | Chunk {-# UNPACK #-} !S.StrictByteString ByteString + -- INVARIANT: The S.StrictByteString field of any Chunk is not empty. -- (See also the 'invariant' and 'checkInvariant' functions.) -- To make testing of this invariant convenient, we add an @@ -97,9 +97,9 @@ data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString -- preprocessor macro is defined, by renaming the actual constructor -- and providing a pattern synonym that does the checking: #else -data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.ByteString ByteString +data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.StrictByteString ByteString -pattern Chunk :: S.ByteString -> ByteString -> ByteString +pattern Chunk :: S.StrictByteString -> ByteString -> ByteString pattern Chunk c cs <- Chunk_ c cs where Chunk c@(S.BS _ len) cs = assert (len > 0) Chunk_ c cs @@ -210,13 +210,13 @@ checkInvariant (Chunk c@(S.BS _ len) cs) ------------------------------------------------------------------------ -- | Smart constructor for 'Chunk'. Guarantees the data type invariant. -chunk :: S.ByteString -> ByteString -> ByteString +chunk :: S.StrictByteString -> ByteString -> ByteString chunk c@(S.BS _ len) cs | len == 0 = cs | otherwise = Chunk c cs {-# INLINE chunk #-} -- | Consume the chunks of a lazy ByteString with a natural right fold. -foldrChunks :: (S.ByteString -> a -> a) -> a -> ByteString -> a +foldrChunks :: (S.StrictByteString -> a -> a) -> a -> ByteString -> a foldrChunks f z = go where go Empty = z go (Chunk c cs) = f c (go cs) @@ -224,7 +224,7 @@ foldrChunks f z = go -- | Consume the chunks of a lazy ByteString with a strict, tail-recursive, -- accumulating left fold. -foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a +foldlChunks :: (a -> S.StrictByteString -> a) -> a -> ByteString -> a foldlChunks f = go where go !a Empty = a go !a (Chunk c cs) = go (f a c) cs @@ -312,18 +312,18 @@ times n lbs0 ------------------------------------------------------------------------ -- Conversions --- |/O(1)/ Convert a strict 'ByteString' into a lazy 'ByteString'. -fromStrict :: S.ByteString -> ByteString +-- |/O(1)/ Convert a 'S.StrictByteString' into a 'LazyByteString'. +fromStrict :: S.StrictByteString -> LazyByteString fromStrict (S.BS _ 0) = Empty fromStrict bs = Chunk bs Empty --- |/O(n)/ Convert a lazy 'ByteString' into a strict 'ByteString'. +-- |/O(n)/ Convert a 'LazyByteString' into a 'S.StrictByteString'. -- --- Note that this is an /expensive/ operation that forces the whole lazy --- ByteString into memory and then copies all the data. If possible, try to +-- Note that this is an /expensive/ operation that forces the whole +-- 'LazyByteString' into memory and then copies all the data. If possible, try to -- avoid converting back and forth between strict and lazy bytestrings. -- -toStrict :: ByteString -> S.ByteString +toStrict :: LazyByteString -> S.StrictByteString toStrict = \cs -> goLen0 cs cs -- We pass the original [ByteString] (bss0) through as an argument through -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing diff --git a/Data/ByteString/Lazy/Internal/Deque.hs b/Data/ByteString/Lazy/Internal/Deque.hs index 8078144a4..d3b436878 100644 --- a/Data/ByteString/Lazy/Internal/Deque.hs +++ b/Data/ByteString/Lazy/Internal/Deque.hs @@ -1,5 +1,5 @@ {- | - A Deque used for accumulating `S.ByteString`s in `Data.ByteString.Lazy.dropEnd`. + A Deque used for accumulating `S.StrictByteString`s in `Data.ByteString.Lazy.dropEnd`. -} module Data.ByteString.Lazy.Internal.Deque ( Deque (..), @@ -15,11 +15,11 @@ import qualified Data.ByteString as S import Data.Int (Int64) import Prelude hiding (head, tail, length, null) --- A `S.ByteString` Deque used as an accumulator for lazy +-- A `S.StrictByteString` Deque used as an accumulator for lazy -- Bytestring operations data Deque = Deque - { front :: [S.ByteString] - , rear :: [S.ByteString] + { front :: [S.StrictByteString] + , rear :: [S.StrictByteString] , -- | Total length in bytes byteLength :: !Int64 } @@ -33,32 +33,32 @@ empty = Deque [] [] 0 null :: Deque -> Bool null deque = byteLength deque == 0 --- Add a `S.ByteString` to the front of the `Deque` +-- Add a `S.StrictByteString` to the front of the `Deque` -- O(1) -cons :: S.ByteString -> Deque -> Deque +cons :: S.StrictByteString -> Deque -> Deque cons x (Deque fs rs acc) = Deque (x : fs) rs (acc + len x) --- Add a `S.ByteString` to the rear of the `Deque` +-- Add a `S.StrictByteString` to the rear of the `Deque` -- O(1) -snoc :: S.ByteString -> Deque -> Deque +snoc :: S.StrictByteString -> Deque -> Deque snoc x (Deque fs rs acc) = Deque fs (x : rs) (acc + len x) -len :: S.ByteString -> Int64 +len :: S.StrictByteString -> Int64 len x = fromIntegral $ S.length x --- Pop a `S.ByteString` from the front of the `Deque` +-- Pop a `S.StrictByteString` from the front of the `Deque` -- Returns the bytestring and the updated Deque, or Nothing if the Deque is empty -- O(1) , occasionally O(n) -popFront :: Deque -> Maybe (S.ByteString, Deque) +popFront :: Deque -> Maybe (S.StrictByteString, Deque) popFront (Deque [] rs acc) = case reverse rs of [] -> Nothing x : xs -> Just (x, Deque xs [] (acc - len x)) popFront (Deque (x : xs) rs acc) = Just (x, Deque xs rs (acc - len x)) --- Pop a `S.ByteString` from the rear of the `Deque` +-- Pop a `S.StrictByteString` from the rear of the `Deque` -- Returns the bytestring and the updated Deque, or Nothing if the Deque is empty -- O(1) , occasionally O(n) -popRear :: Deque -> Maybe (Deque, S.ByteString) +popRear :: Deque -> Maybe (Deque, S.StrictByteString) popRear (Deque fs [] acc) = case reverse fs of [] -> Nothing x : xs -> Just (Deque [] xs (acc - len x), x)