{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Unsafe #-}
#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(..),     -- instances: Eq, Ord, Show, Read, Data, Typeable
        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,

  ) where

import Prelude hiding (concat)

import qualified Data.ByteString.Internal as S
import qualified Data.ByteString          as S (length, take, drop)

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

#if MIN_VERSION_base(4,13,0)
import Data.Semigroup   (Semigroup (sconcat))
import Data.List.NonEmpty (NonEmpty ((:|)))
#elif MIN_VERSION_base(4,9,0)
import Data.Semigroup   (Semigroup ((<>), sconcat))
import Data.List.NonEmpty (NonEmpty ((:|)))
#endif
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid      (Monoid(..))
#endif
import Control.DeepSeq  (NFData, rnf)

import Data.String      (IsString(..))

import Data.Typeable            (Typeable)
import Data.Data                (Data(..), mkNoRepType)

#if MIN_VERSION_base(4,7,0)
import GHC.Exts                 (IsList(..))
#endif

-- | A space-efficient representation of a 'Word8' vector, supporting many
-- efficient operations.
--
-- A lazy 'ByteString' contains 8-bit bytes, or by using the operations
-- from "Data.ByteString.Lazy.Char8" it can be interpreted as containing
-- 8-bit characters.
--
data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString
    deriving (Typeable)
-- See 'invariant' function later in this module for internal invariants.

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

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

#if MIN_VERSION_base(4,9,0)
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)
#endif

instance Monoid ByteString where
    mempty :: ByteString
mempty  = ByteString
Empty
#if MIN_VERSION_base(4,9,0)
    mappend :: ByteString -> ByteString -> ByteString
mappend = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>)
#else
    mappend = append
#endif
    mconcat :: [ByteString] -> ByteString
mconcat = [ByteString] -> ByteString
concat

instance NFData ByteString where
    rnf :: ByteString -> ()
rnf ByteString
Empty       = ()
    rnf (Chunk ByteString
_ 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 ]

#if MIN_VERSION_base(4,7,0)
-- | @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
#endif

-- | 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
_     = String -> Constr
forall a. HasCallStack => String -> a
error String
"Data.ByteString.Lazy.ByteString.toConstr"
  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
_ forall r. r -> c r
_    = String -> Constr -> c ByteString
forall a. HasCallStack => String -> a
error String
"Data.ByteString.Lazy.ByteString.gunfold"
  dataTypeOf :: ByteString -> DataType
dataTypeOf ByteString
_   = 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] -> (ByteString, [Word8])
S.packUptoLenBytes Int
n [Word8]
cs of
      (ByteString
bs, [])  -> ByteString -> ByteString -> ByteString
chunk ByteString
bs ByteString
Empty
      (ByteString
bs, [Word8]
cs') -> ByteString -> ByteString -> ByteString
Chunk ByteString
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 -> (ByteString, String)
S.packUptoLenChars Int
n String
cs of
      (ByteString
bs, [])  -> ByteString -> ByteString -> ByteString
chunk ByteString
bs ByteString
Empty
      (ByteString
bs, String
cs') -> ByteString -> ByteString -> ByteString
Chunk ByteString
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 ByteString
c ByteString
cs) = ByteString -> [Word8] -> [Word8]
S.unpackAppendBytesLazy ByteString
c (ByteString -> [Word8]
unpackBytes ByteString
cs)

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

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

-- | The data type invariant:
-- Every ByteString is either 'Empty' or consists of non-null 'S.ByteString's.
-- All functions must preserve this, and the QC properties must check this.
--
invariant :: ByteString -> Bool
invariant :: ByteString -> Bool
invariant ByteString
Empty                     = Bool
True
invariant (Chunk (S.PS ForeignPtr Word8
_ Int
_ 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

-- | In a form that checks the invariant lazily.
checkInvariant :: ByteString -> ByteString
checkInvariant :: ByteString -> ByteString
checkInvariant ByteString
Empty = ByteString
Empty
checkInvariant (Chunk c :: ByteString
c@(S.PS ForeignPtr Word8
_ Int
_ Int
len) ByteString
cs)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   = ByteString -> ByteString -> ByteString
Chunk ByteString
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 (ByteString -> ByteString -> ByteString
Chunk ByteString
c ByteString
cs)

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

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

-- | Consume the chunks of a lazy ByteString with a natural right fold.
foldrChunks :: (S.ByteString -> a -> a) -> a -> ByteString -> a
foldrChunks :: forall a. (ByteString -> a -> a) -> a -> ByteString -> a
foldrChunks ByteString -> a -> a
f a
z = ByteString -> a
go
  where go :: ByteString -> a
go ByteString
Empty        = a
z
        go (Chunk ByteString
c ByteString
cs) = ByteString -> a -> a
f ByteString
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.ByteString -> a) -> a -> ByteString -> a
foldlChunks :: forall a. (a -> ByteString -> a) -> a -> ByteString -> a
foldlChunks a -> ByteString -> a
f a
z = a -> ByteString -> a
go a
z
  where go :: a -> ByteString -> a
go a
a ByteString
_ | a
a a -> Bool -> Bool
`seq` Bool
False = a
forall a. HasCallStack => a
undefined
        go a
a ByteString
Empty        = a
a
        go a
a (Chunk ByteString
c ByteString
cs) = a -> ByteString -> a
go (a -> ByteString -> a
f a
a ByteString
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 ByteString
a ByteString
as) (Chunk ByteString
b ByteString
bs) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> Int
S.length ByteString
a) (ByteString -> Int
S.length ByteString
b) of
    Ordering
LT -> ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
a) ByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as (ByteString -> ByteString -> ByteString
Chunk (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
a) ByteString
b) ByteString
bs)
    Ordering
EQ -> ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b                     Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as ByteString
bs
    Ordering
GT -> Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
b) ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq (ByteString -> ByteString -> ByteString
Chunk (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
b) ByteString
a) 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 ByteString
a ByteString
as) (Chunk ByteString
b ByteString
bs) =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> Int
S.length ByteString
a) (ByteString -> Int
S.length ByteString
b) of
    Ordering
LT -> case ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
a (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
a) ByteString
b) of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp ByteString
as (ByteString -> ByteString -> ByteString
Chunk (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
a) ByteString
b) ByteString
bs)
            Ordering
result -> Ordering
result
    Ordering
EQ -> case ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
a ByteString
b of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp ByteString
as ByteString
bs
            Ordering
result -> Ordering
result
    Ordering
GT -> case ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ByteString
b) ByteString
a) ByteString
b of
            Ordering
EQ     -> ByteString -> ByteString -> Ordering
cmp (ByteString -> ByteString -> ByteString
Chunk (Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
b) ByteString
a) ByteString
as) ByteString
bs
            Ordering
result -> Ordering
result

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

concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat [ByteString]
css0 = [ByteString] -> ByteString
to [ByteString]
css0
  where
    go :: ByteString -> [ByteString] -> ByteString
go ByteString
Empty        [ByteString]
css = [ByteString] -> ByteString
to [ByteString]
css
    go (Chunk ByteString
c ByteString
cs) [ByteString]
css = ByteString -> ByteString -> ByteString
Chunk ByteString
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