{-# 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 (
ByteString(Empty, Chunk),
LazyByteString,
chunk,
foldrChunks,
foldlChunks,
invariant,
checkInvariant,
defaultChunkSize,
smallChunkSize,
chunkOverhead,
packBytes, packChars,
unpackBytes, unpackChars,
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(..), mkNoRepType)
import GHC.Exts (IsList(..))
import qualified Language.Haskell.TH.Syntax as TH
#ifdef HS_BYTESTRING_ASSERTIONS
import Control.Exception (assert)
#endif
#ifndef HS_BYTESTRING_ASSERTIONS
data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString
#else
data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.ByteString ByteString
pattern Chunk :: S.ByteString -> 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 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
bforall a. a -> [a] -> [a]
:[ByteString]
bs)
stimes :: forall b. Integral b => b -> ByteString -> ByteString
stimes = forall b. Integral b => b -> ByteString -> ByteString
times
instance Monoid ByteString where
mempty :: ByteString
mempty = ByteString
Empty
mappend :: ByteString -> ByteString -> ByteString
mappend = 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 ByteString
_ ByteString
b) = forall a. NFData a => a -> ()
rnf ByteString
b
instance Show ByteString where
showsPrec :: Int -> ByteString -> ShowS
showsPrec Int
p ByteString
ps String
r = 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) <- forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
instance IsList ByteString where
type Item ByteString = Word8
fromList :: [Item ByteString] -> ByteString
fromList = [Word8] -> ByteString
packBytes
toList :: ByteString -> [Item ByteString]
toList = ByteString -> [Word8]
unpackBytes
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 = forall g. g -> c g
z [Word8] -> ByteString
packBytes forall d b. Data d => c (d -> b) -> d -> c b
`f` ByteString -> [Word8]
unpackBytes ByteString
txt
toConstr :: ByteString -> Constr
toConstr ByteString
_ = 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
_ = 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"
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 (forall a. Ord a => a -> a -> a
min (Int
n 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 (forall a. Ord a => a -> a -> a
min (Int
n 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)
invariant :: ByteString -> Bool
invariant :: ByteString -> Bool
invariant ByteString
Empty = Bool
True
invariant (Chunk (S.BS ForeignPtr Word8
_ Int
len) ByteString
cs) = Int
len forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ByteString -> Bool
invariant ByteString
cs
checkInvariant :: ByteString -> ByteString
checkInvariant :: ByteString -> ByteString
checkInvariant ByteString
Empty = ByteString
Empty
checkInvariant (Chunk c :: ByteString
c@(S.BS ForeignPtr Word8
_ Int
len) ByteString
cs)
| Int
len forall a. Ord a => a -> a -> Bool
> Int
0 = ByteString -> ByteString -> ByteString
Chunk ByteString
c (ByteString -> ByteString
checkInvariant ByteString
cs)
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.ByteString.Lazy: invariant violation:"
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> ByteString -> ByteString
Chunk ByteString
c ByteString
cs)
chunk :: S.ByteString -> ByteString -> ByteString
chunk :: ByteString -> ByteString -> ByteString
chunk c :: ByteString
c@(S.BS ForeignPtr Word8
_ Int
len) ByteString
cs | Int
len forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
cs
| Bool
otherwise = ByteString -> ByteString -> ByteString
Chunk ByteString
c ByteString
cs
{-# INLINE chunk #-}
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 #-}
foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a
foldlChunks :: forall a. (a -> ByteString -> a) -> a -> ByteString -> a
foldlChunks a -> ByteString -> a
f = a -> ByteString -> a
go
where go :: a -> ByteString -> a
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 #-}
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
32 forall a. Num a => a -> a -> a
* Int
k forall a. Num a => a -> a -> a
- Int
chunkOverhead
where k :: Int
k = Int
1024
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = Int
4 forall a. Num a => a -> a -> a
* Int
k forall a. Num a => a -> a -> a
- Int
chunkOverhead
where k :: Int
k = Int
1024
chunkOverhead :: Int
chunkOverhead :: Int
chunkOverhead = Int
2 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Int)
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 :: ByteString
a@(S.BS ForeignPtr Word8
ap Int
al) ByteString
as) (Chunk b :: ByteString
b@(S.BS ForeignPtr Word8
bp Int
bl) ByteString
bs) =
case forall a. Ord a => a -> a -> Ordering
compare Int
al Int
bl of
Ordering
LT -> ByteString
a forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8 -> Int -> ByteString
S.BS ForeignPtr Word8
bp Int
al Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as (ByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> ByteString
S.BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
bp Int
al) (Int
bl forall a. Num a => a -> a -> a
- Int
al)) ByteString
bs)
Ordering
EQ -> ByteString
a forall a. Eq a => a -> a -> Bool
== ByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq ByteString
as ByteString
bs
Ordering
GT -> ForeignPtr Word8 -> Int -> ByteString
S.BS ForeignPtr Word8
ap Int
bl forall a. Eq a => a -> a -> Bool
== ByteString
b Bool -> Bool -> Bool
&& ByteString -> ByteString -> Bool
eq (ByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> ByteString
S.BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
ap Int
bl) (Int
al 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 :: ByteString
a@(S.BS ForeignPtr Word8
ap Int
al) ByteString
as) (Chunk b :: ByteString
b@(S.BS ForeignPtr Word8
bp Int
bl) ByteString
bs) =
case forall a. Ord a => a -> a -> Ordering
compare Int
al Int
bl of
Ordering
LT -> case forall a. Ord a => a -> a -> Ordering
compare ByteString
a (ForeignPtr Word8 -> Int -> ByteString
S.BS ForeignPtr Word8
bp Int
al) of
Ordering
EQ -> ByteString -> ByteString -> Ordering
cmp ByteString
as (ByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> ByteString
S.BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
bp Int
al) (Int
bl forall a. Num a => a -> a -> a
- Int
al)) ByteString
bs)
Ordering
result -> Ordering
result
Ordering
EQ -> case 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 forall a. Ord a => a -> a -> Ordering
compare (ForeignPtr Word8 -> Int -> ByteString
S.BS ForeignPtr Word8
ap Int
bl) ByteString
b of
Ordering
EQ -> ByteString -> ByteString -> Ordering
cmp (ByteString -> ByteString -> ByteString
Chunk (ForeignPtr Word8 -> Int -> ByteString
S.BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
S.plusForeignPtr ForeignPtr Word8
ap Int
bl) (Int
al 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 = 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] -> ByteString
to
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
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 forall a. Ord a => a -> a -> Bool
< a
0 = forall a. HasCallStack => String -> a
error String
"stimes: non-negative multiplier expected"
| Bool
otherwise = case ByteString
lbs0 of
ByteString
Empty -> ByteString
Empty
Chunk ByteString
bs ByteString
lbs -> ByteString -> ByteString -> ByteString
Chunk ByteString
bs (ByteString -> ByteString
go ByteString
lbs)
where
go :: ByteString -> ByteString
go ByteString
Empty = forall b. Integral b => b -> ByteString -> ByteString
times (a
nforall a. Num a => a -> a -> a
-a
1) ByteString
lbs0
go (Chunk ByteString
c ByteString
cs) = ByteString -> ByteString -> ByteString
Chunk ByteString
c (ByteString -> ByteString
go ByteString
cs)
fromStrict :: S.ByteString -> ByteString
fromStrict :: ByteString -> ByteString
fromStrict (S.BS ForeignPtr Word8
_ Int
0) = ByteString
Empty
fromStrict ByteString
bs = ByteString -> ByteString -> ByteString
Chunk ByteString
bs ByteString
Empty
toStrict :: ByteString -> S.ByteString
toStrict :: ByteString -> ByteString
toStrict = \ByteString
cs -> ByteString -> ByteString -> ByteString
goLen0 ByteString
cs ByteString
cs
where
goLen0 :: ByteString -> ByteString -> ByteString
goLen0 ByteString
_ ByteString
Empty = ForeignPtr Word8 -> Int -> ByteString
S.BS ForeignPtr Word8
S.nullForeignPtr Int
0
goLen0 ByteString
cs0 (Chunk ByteString
c ByteString
cs) = ByteString -> ByteString -> ByteString -> ByteString
goLen1 ByteString
cs0 ByteString
c ByteString
cs
goLen1 :: ByteString -> ByteString -> ByteString -> ByteString
goLen1 ByteString
_ ByteString
bs ByteString
Empty = ByteString
bs
goLen1 ByteString
cs0 (S.BS ForeignPtr Word8
_ Int
bl) (Chunk (S.BS ForeignPtr Word8
_ Int
cl) ByteString
cs) =
ByteString -> Int -> ByteString -> ByteString
goLen ByteString
cs0 (String -> Int -> Int -> Int
S.checkedAdd String
"Lazy.concat" Int
bl Int
cl) ByteString
cs
goLen :: ByteString -> Int -> ByteString -> ByteString
goLen ByteString
cs0 !Int
total (Chunk (S.BS ForeignPtr Word8
_ Int
cl) ByteString
cs) =
ByteString -> Int -> ByteString -> ByteString
goLen ByteString
cs0 (String -> Int -> Int -> Int
S.checkedAdd String
"Lazy.concat" Int
total Int
cl) ByteString
cs
goLen ByteString
cs0 Int
total ByteString
Empty =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
S.unsafeCreateFp Int
total forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
ptr -> ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
cs0 ForeignPtr Word8
ptr
goCopy :: ByteString -> ForeignPtr Word8 -> IO ()
goCopy ByteString
Empty !ForeignPtr Word8
_ = 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 forall a b. ForeignPtr a -> Int -> ForeignPtr b
`S.plusForeignPtr` Int
len)