{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Unsafe #-}

#ifdef HS_BYTESTRING_ASSERTIONS
{-# LANGUAGE PatternSynonyms #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.ByteString.Lazy.Internal
-- Copyright   : (c) Don Stewart 2006-2008
--               (c) Duncan Coutts 2006-2011
-- License     : BSD-style
-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org
-- Stability   : unstable
-- Portability : non-portable
--
-- A module containing semi-public 'ByteString' internals. This exposes
-- the 'ByteString' representation and low level construction functions.
-- Modules which extend the 'ByteString' system will need to use this module
-- while ideally most users will be able to make do with the public interface
-- modules.
--
module Data.ByteString.Lazy.Internal (

        -- * The lazy @ByteString@ type and representation
        ByteString(Empty, Chunk),
        LazyByteString,
        chunk,
        foldrChunks,
        foldlChunks,

        -- * Data type invariant and abstraction function
        invariant,
        checkInvariant,

        -- * Chunk allocation sizes
        defaultChunkSize,
        smallChunkSize,
        chunkOverhead,

        -- * Conversion with lists: packing and unpacking
        packBytes, packChars,
        unpackBytes, unpackChars,
        -- * Conversions with strict ByteString
        fromStrict, toStrict,

  ) where

import Prelude hiding (concat)

import qualified Data.ByteString.Internal.Type as S

import Data.Word (Word8)
import Foreign.Storable (Storable(sizeOf))

#if MIN_VERSION_base(4,13,0)
import Data.Semigroup   (Semigroup (sconcat, stimes))
#else
import Data.Semigroup   (Semigroup ((<>), sconcat, stimes))
#endif
import Data.List.NonEmpty (NonEmpty ((:|)))
import Control.DeepSeq  (NFData, rnf)

import Data.String      (IsString(..))

import Data.Data                (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex)

import GHC.Exts                 (IsList(..))

import qualified Language.Haskell.TH.Syntax as TH

#ifdef HS_BYTESTRING_ASSERTIONS
import Control.Exception (assert)
#endif


-- | A space-efficient representation of a 'Word8' vector, supporting many
-- efficient 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.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
  -- assertion to that effect when the HS_BYTESTRING_ASSERTIONS
  -- 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.StrictByteString 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

{-# COMPLETE Empty, Chunk #-}
#endif

deriving instance TH.Lift ByteString


-- | Type synonym for the lazy flavour of 'ByteString'.
--
-- @since 0.11.2.0
type LazyByteString = ByteString

instance Eq  ByteString where
    == :: ByteString -> ByteString -> Bool
(==)    = ByteString -> ByteString -> Bool
eq

instance Ord ByteString where
    compare :: ByteString -> ByteString -> Ordering
compare = ByteString -> ByteString -> Ordering
cmp

instance Semigroup ByteString where
    <> :: ByteString -> ByteString -> ByteString
(<>)    = ByteString -> ByteString -> ByteString
append
    sconcat :: NonEmpty ByteString -> ByteString
sconcat (ByteString
b:|[ByteString]
bs) = [ByteString] -> ByteString
concat (ByteString
bByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bs)
    stimes :: forall b. Integral b => b -> ByteString -> ByteString
stimes  = b -> ByteString -> ByteString
forall b. Integral b => b -> ByteString -> ByteString
times

instance Monoid ByteString where
    mempty :: ByteString
mempty  = ByteString
Empty
    mappend :: ByteString -> ByteString -> ByteString
mappend = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [ByteString] -> ByteString
mconcat = [ByteString] -> ByteString
concat

instance NFData ByteString where
    rnf :: ByteString -> ()
rnf ByteString
Empty       = ()
    rnf (Chunk StrictByteString
_ ByteString
b) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
b

instance Show ByteString where
    showsPrec :: Int -> ByteString -> ShowS
showsPrec Int
p ByteString
ps String
r = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (ByteString -> String
unpackChars ByteString
ps) String
r

instance Read ByteString where
    readsPrec :: Int -> ReadS ByteString
readsPrec Int
p String
str = [ (String -> ByteString
packChars String
x, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]

-- | @since 0.10.12.0
instance IsList ByteString where
  type Item ByteString = Word8
  fromList :: [Item ByteString] -> ByteString
fromList = [Word8] -> ByteString
[Item ByteString] -> ByteString
packBytes
  toList :: ByteString -> [Item ByteString]
toList   = ByteString -> [Word8]
ByteString -> [Item ByteString]
unpackBytes

-- | Beware: 'fromString' truncates multi-byte characters to octets.
-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�
instance IsString ByteString where
    fromString :: String -> ByteString
fromString = String -> ByteString
packChars

instance Data ByteString where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteString -> c ByteString
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z ByteString
txt = ([Word8] -> ByteString) -> c ([Word8] -> ByteString)
forall g. g -> c g
z [Word8] -> ByteString
packBytes c ([Word8] -> ByteString) -> [Word8] -> c ByteString
forall d b. Data d => c (d -> b) -> d -> c b
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
  toConstr :: ByteString -> Constr
toConstr ByteString
_     = Constr
packConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteString
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c ([Word8] -> ByteString) -> c ByteString
forall b r. Data b => c (b -> r) -> c r
k (([Word8] -> ByteString) -> c ([Word8] -> ByteString)
forall r. r -> c r
z [Word8] -> ByteString
packBytes)
    Int
_ -> String -> c ByteString
forall a. HasCallStack => String -> a
error String
"gunfold: unexpected constructor of lazy ByteString"
  dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_   = DataType
byteStringDataType

packConstr :: Constr
packConstr :: Constr
packConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
byteStringDataType String
"pack" [] Fixity
Prefix

byteStringDataType :: DataType
byteStringDataType :: DataType
byteStringDataType = String -> DataType
mkNoRepType String
"Data.ByteString.Lazy.ByteString"

------------------------------------------------------------------------
-- Packing and unpacking from lists

packBytes :: [Word8] -> ByteString
packBytes :: [Word8] -> ByteString
packBytes [Word8]
cs0 =
    Int -> [Word8] -> ByteString
packChunks Int
32 [Word8]
cs0
  where
    packChunks :: Int -> [Word8] -> ByteString
packChunks Int
n [Word8]
cs = case Int -> [Word8] -> (StrictByteString, [Word8])
S.packUptoLenBytes Int
n [Word8]
cs of
      (StrictByteString
bs, [])  -> StrictByteString -> ByteString -> ByteString
chunk StrictByteString
bs ByteString
Empty
      (StrictByteString
bs, [Word8]
cs') -> StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
bs (Int -> [Word8] -> ByteString
packChunks (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
smallChunkSize) [Word8]
cs')

packChars :: [Char] -> ByteString
packChars :: String -> ByteString
packChars String
cs0 = Int -> String -> ByteString
packChunks Int
32 String
cs0
  where
    packChunks :: Int -> String -> ByteString
packChunks Int
n String
cs = case Int -> String -> (StrictByteString, String)
S.packUptoLenChars Int
n String
cs of
      (StrictByteString
bs, [])  -> StrictByteString -> ByteString -> ByteString
chunk StrictByteString
bs ByteString
Empty
      (StrictByteString
bs, String
cs') -> StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
bs (Int -> String -> ByteString
packChunks (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
smallChunkSize) String
cs')

unpackBytes :: ByteString -> [Word8]
unpackBytes :: ByteString -> [Word8]
unpackBytes ByteString
Empty        = []
unpackBytes (Chunk StrictByteString
c ByteString
cs) = StrictByteString -> [Word8] -> [Word8]
S.unpackAppendBytesLazy StrictByteString
c (ByteString -> [Word8]
unpackBytes ByteString
cs)

unpackChars :: ByteString -> [Char]
unpackChars :: ByteString -> String
unpackChars ByteString
Empty        = []
unpackChars (Chunk StrictByteString
c ByteString
cs) = StrictByteString -> ShowS
S.unpackAppendCharsLazy StrictByteString
c (ByteString -> String
unpackChars ByteString
cs)

------------------------------------------------------------------------

-- We no longer use these invariant-checking functions internally,
-- preferring an assertion on `Chunk` itself, controlled by the
-- HS_BYTESTRING_ASSERTIONS preprocessor macro.

-- | The data type invariant:
-- Every ByteString is either 'Empty' or consists of non-null
-- 'S.StrictByteString's. All functions must preserve this.
--
invariant :: ByteString -> Bool
invariant :: ByteString -> Bool
invariant ByteString
Empty                     = Bool
True
invariant (Chunk (S.BS ForeignPtr Word8
_ Int
len) ByteString
cs) = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ByteString -> Bool
invariant ByteString
cs

-- | Lazily checks that the given 'ByteString' satisfies the data type's
-- "no empty chunks" invariant, raising an exception in place of the
-- first chunk that does not satisfy the invariant.
checkInvariant :: ByteString -> ByteString
checkInvariant :: ByteString -> ByteString
checkInvariant ByteString
Empty = ByteString
Empty
checkInvariant (Chunk c :: StrictByteString
c@(S.BS ForeignPtr Word8
_ Int
len) ByteString
cs)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   = StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
c (ByteString -> ByteString
checkInvariant ByteString
cs)
    | Bool
otherwise = String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Data.ByteString.Lazy: invariant violation:"
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
c ByteString
cs)

------------------------------------------------------------------------

-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
chunk :: S.StrictByteString -> ByteString -> ByteString
chunk :: StrictByteString -> ByteString -> ByteString
chunk c :: StrictByteString
c@(S.BS ForeignPtr Word8
_ Int
len) ByteString
cs | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = ByteString
cs
                        | Bool
otherwise = StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
c ByteString
cs
{-# INLINE chunk #-}

-- | Consume the chunks of a lazy ByteString with a natural right fold.
foldrChunks :: (S.StrictByteString -> a -> a) -> a -> ByteString -> a
foldrChunks :: forall a. (StrictByteString -> a -> a) -> a -> ByteString -> a
foldrChunks StrictByteString -> a -> a
f a
z = ByteString -> a
go
  where go :: ByteString -> a
go ByteString
Empty        = a
z
        go (Chunk StrictByteString
c ByteString
cs) = StrictByteString -> a -> a
f StrictByteString
c (ByteString -> a
go ByteString
cs)
{-# INLINE foldrChunks #-}

-- | Consume the chunks of a lazy ByteString with a strict, tail-recursive,
-- accumulating left fold.
foldlChunks :: (a -> S.StrictByteString -> a) -> a -> ByteString -> a
foldlChunks :: forall a. (a -> StrictByteString -> a) -> a -> ByteString -> a
foldlChunks a -> StrictByteString -> a
f = a -> ByteString -> a
go
  where go :: a -> ByteString -> a
go !a
a ByteString
Empty        = a
a
        go !a
a (Chunk StrictByteString
c ByteString
cs) = a -> ByteString -> a
go (a -> StrictByteString -> a
f a
a StrictByteString
c) ByteString
cs
{-# INLINE foldlChunks #-}

------------------------------------------------------------------------

-- The representation uses lists of packed chunks. When we have to convert from
-- a lazy list to the chunked representation, then by default we use this
-- chunk size. Some functions give you more control over the chunk size.
--
-- Measurements here:
--  http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png
--
-- indicate that a value around 0.5 to 1 x your L2 cache is best.
-- The following value assumes people have something greater than 128k,
-- and need to share the cache with other programs.

-- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
   where k :: Int
k = Int
1024

-- | The recommended chunk size. Currently set to 4k, less the memory management overhead
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead
   where k :: Int
k = Int
1024

-- | The memory management overhead. Currently this is tuned for GHC only.
chunkOverhead :: Int
chunkOverhead :: Int
chunkOverhead = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)

------------------------------------------------------------------------
-- Implementations for Eq, Ord and Monoid instances

eq :: ByteString -> ByteString -> Bool
eq :: ByteString -> ByteString -> Bool
eq ByteString
Empty ByteString
Empty = Bool
True
eq ByteString
Empty ByteString
_     = Bool
False
eq ByteString
_     ByteString
Empty = Bool
False
eq (Chunk a :: StrictByteString
a@(S.BS ForeignPtr Word8
ap Int
al) ByteString
as) (Chunk b :: StrictByteString
b@(S.BS ForeignPtr Word8
bp Int
bl) ByteString
bs) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
al Int
bl of
    Ordering
LT -> StrictByteString
a StrictByteString -> StrictByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
bp Int
al Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as (StrictByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> StrictByteString
S.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
bp Int
al) (Int
bl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al)) ByteString
bs)
    Ordering
EQ -> StrictByteString
a StrictByteString -> StrictByteString -> Bool
forall a. Eq a => a -> a -> Bool
== StrictByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as ByteString
bs
    Ordering
GT -> ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
ap Int
bl StrictByteString -> StrictByteString -> Bool
forall a. Eq a => a -> a -> Bool
== StrictByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq (StrictByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> StrictByteString
S.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
ap Int
bl) (Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl)) ByteString
as) ByteString
bs

cmp :: ByteString -> ByteString -> Ordering
cmp :: ByteString -> ByteString -> Ordering
cmp ByteString
Empty ByteString
Empty = Ordering
EQ
cmp ByteString
Empty ByteString
_     = Ordering
LT
cmp ByteString
_     ByteString
Empty = Ordering
GT
cmp (Chunk a :: StrictByteString
a@(S.BS ForeignPtr Word8
ap Int
al) ByteString
as) (Chunk b :: StrictByteString
b@(S.BS ForeignPtr Word8
bp Int
bl) ByteString
bs) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
al Int
bl of
    Ordering
LT -> case StrictByteString -> StrictByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare StrictByteString
a (ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
bp Int
al) of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp ByteString
as (StrictByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> StrictByteString
S.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
bp Int
al) (Int
bl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al)) ByteString
bs)
            Ordering
result -> Ordering
result
    Ordering
EQ -> case StrictByteString -> StrictByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare StrictByteString
a StrictByteString
b of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp ByteString
as ByteString
bs
            Ordering
result -> Ordering
result
    Ordering
GT -> case StrictByteString -> StrictByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
ap Int
bl) StrictByteString
b of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp (StrictByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> StrictByteString
S.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
ap Int
bl) (Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl)) ByteString
as) ByteString
bs
            Ordering
result -> Ordering
result

append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append ByteString
xs ByteString
ys = (StrictByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a. (StrictByteString -> a -> a) -> a -> ByteString -> a
foldrChunks StrictByteString -> ByteString -> ByteString
Chunk ByteString
ys ByteString
xs

concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat = [ByteString] -> ByteString
to
  where
    go :: ByteString -> [ByteString] -> ByteString
go ByteString
Empty        [ByteString]
css = [ByteString] -> ByteString
to [ByteString]
css
    go (Chunk StrictByteString
c ByteString
cs) [ByteString]
css = StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
c (ByteString -> [ByteString] -> ByteString
go ByteString
cs [ByteString]
css)
    to :: [ByteString] -> ByteString
to []               = ByteString
Empty
    to (ByteString
cs:[ByteString]
css)         = ByteString -> [ByteString] -> ByteString
go ByteString
cs [ByteString]
css

-- | Repeats the given ByteString n times.
times :: Integral a => a -> ByteString -> ByteString
times :: forall b. Integral b => b -> ByteString -> ByteString
times a
0 ByteString
_ = ByteString
Empty
times a
n ByteString
lbs0
  | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = String -> ByteString
forall a. HasCallStack => String -> a
error String
"stimes: non-negative multiplier expected"
  | Bool
otherwise = case ByteString
lbs0 of
    ByteString
Empty -> ByteString
Empty
    Chunk StrictByteString
bs ByteString
lbs -> StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
bs (ByteString -> ByteString
go ByteString
lbs)
  where
    go :: ByteString -> ByteString
go ByteString
Empty = a -> ByteString -> ByteString
forall b. Integral b => b -> ByteString -> ByteString
times (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) ByteString
lbs0
    go (Chunk StrictByteString
c ByteString
cs) = StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
c (ByteString -> ByteString
go ByteString
cs)

------------------------------------------------------------------------
-- Conversions

-- |/O(1)/ Convert a 'S.StrictByteString' into a 'LazyByteString'.
fromStrict :: S.StrictByteString -> LazyByteString
fromStrict :: StrictByteString -> ByteString
fromStrict (S.BS ForeignPtr Word8
_ Int
0) = ByteString
Empty
fromStrict StrictByteString
bs = StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
bs ByteString
Empty

-- |/O(n)/ Convert a 'LazyByteString' into a 'S.StrictByteString'.
--
-- 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 :: LazyByteString -> S.StrictByteString
toStrict :: ByteString -> StrictByteString
toStrict = \ByteString
cs -> ByteString -> ByteString -> StrictByteString
goLen0 ByteString
cs ByteString
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
    -- it as an explicit argument avoids capturing it in these functions'
    -- closures which would result in unnecessary closure allocation.
  where
    -- It's still possible that the result is empty
    goLen0 :: ByteString -> ByteString -> StrictByteString
goLen0 ByteString
_   ByteString
Empty                 = ForeignPtr Word8 -> Int -> StrictByteString
S.BS ForeignPtr Word8
S.nullForeignPtr Int
0
    goLen0 ByteString
cs0 (Chunk StrictByteString
c ByteString
cs)          = ByteString -> StrictByteString -> ByteString -> StrictByteString
goLen1 ByteString
cs0 StrictByteString
c ByteString
cs

    -- It's still possible that the result is a single chunk
    goLen1 :: ByteString -> StrictByteString -> ByteString -> StrictByteString
goLen1 ByteString
_   StrictByteString
bs ByteString
Empty = StrictByteString
bs
    goLen1 ByteString
cs0 (S.BS ForeignPtr Word8
_ Int
bl) (Chunk (S.BS ForeignPtr Word8
_ Int
cl) ByteString
cs) =
        ByteString -> Int -> ByteString -> StrictByteString
goLen ByteString
cs0 (String -> Int -> Int -> Int
S.checkedAdd String
"Lazy.toStrict" Int
bl Int
cl) ByteString
cs

    -- General case, just find the total length we'll need
    goLen :: ByteString -> Int -> ByteString -> StrictByteString
goLen ByteString
cs0 !Int
total (Chunk (S.BS ForeignPtr Word8
_ Int
cl) ByteString
cs) =
      ByteString -> Int -> ByteString -> StrictByteString
goLen ByteString
cs0 (String -> Int -> Int -> Int
S.checkedAdd String
"Lazy.toStrict" Int
total Int
cl) ByteString
cs
    goLen ByteString
cs0 Int
total ByteString
Empty =
      Int -> (ForeignPtr Word8 -> IO ()) -> StrictByteString
S.unsafeCreateFp Int
total ((ForeignPtr Word8 -> IO ()) -> StrictByteString)
-> (ForeignPtr Word8 -> IO ()) -> StrictByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
ptr -> ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
cs0 ForeignPtr Word8
ptr

    -- Copy the data
    goCopy :: ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
Empty                    !ForeignPtr Word8
_   = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    goCopy (Chunk (S.BS ForeignPtr Word8
_  Int
0  ) ByteString
cs) !ForeignPtr Word8
ptr = ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
cs ForeignPtr Word8
ptr
    goCopy (Chunk (S.BS ForeignPtr Word8
fp Int
len) ByteString
cs) !ForeignPtr Word8
ptr = do
      ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
S.memcpyFp ForeignPtr Word8
ptr ForeignPtr Word8
fp Int
len
      ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
cs (ForeignPtr Word8
ptr ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`S.plusForeignPtr` Int
len)
-- See the comment on Data.ByteString.Internal.concat for some background on
-- this implementation.