{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Unsafe #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
module Data.ByteString.Lazy.Internal (
ByteString(..),
chunk,
foldrChunks,
foldlChunks,
invariant,
checkInvariant,
defaultChunkSize,
smallChunkSize,
chunkOverhead,
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,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#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)
data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString
deriving (Typeable)
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
#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 Empty = ()
rnf (Chunk _ b :: ByteString
b) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
b
instance Show ByteString where
showsPrec :: Int -> ByteString -> ShowS
showsPrec p :: Int
p ps :: ByteString
ps r :: 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 p :: Int
p str :: String
str = [ (String -> ByteString
packChars String
x, String
y) | (x :: String
x, y :: String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
instance IsString ByteString where
fromString :: String -> ByteString
fromString = String -> ByteString
packChars
instance Data ByteString where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteString -> c ByteString
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z txt :: 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 _ = String -> Constr
forall a. HasCallStack => String -> a
error "Data.ByteString.Lazy.ByteString.toConstr"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteString
gunfold _ _ = String -> Constr -> c ByteString
forall a. HasCallStack => String -> a
error "Data.ByteString.Lazy.ByteString.gunfold"
dataTypeOf :: ByteString -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "Data.ByteString.Lazy.ByteString"
packBytes :: [Word8] -> ByteString
packBytes :: [Word8] -> ByteString
packBytes cs0 :: [Word8]
cs0 =
Int -> [Word8] -> ByteString
packChunks 32 [Word8]
cs0
where
packChunks :: Int -> [Word8] -> ByteString
packChunks n :: Int
n cs :: [Word8]
cs = case Int -> [Word8] -> (ByteString, [Word8])
S.packUptoLenBytes Int
n [Word8]
cs of
(bs :: ByteString
bs, []) -> ByteString -> ByteString -> ByteString
chunk ByteString
bs ByteString
Empty
(bs :: ByteString
bs, cs' :: [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
* 2) Int
smallChunkSize) [Word8]
cs')
packChars :: [Char] -> ByteString
packChars :: String -> ByteString
packChars cs0 :: String
cs0 = Int -> String -> ByteString
packChunks 32 String
cs0
where
packChunks :: Int -> String -> ByteString
packChunks n :: Int
n cs :: String
cs = case Int -> String -> (ByteString, String)
S.packUptoLenChars Int
n String
cs of
(bs :: ByteString
bs, []) -> ByteString -> ByteString -> ByteString
chunk ByteString
bs ByteString
Empty
(bs :: ByteString
bs, cs' :: 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
* 2) Int
smallChunkSize) String
cs')
unpackBytes :: ByteString -> [Word8]
unpackBytes :: ByteString -> [Word8]
unpackBytes Empty = []
unpackBytes (Chunk c :: ByteString
c cs :: ByteString
cs) = ByteString -> [Word8] -> [Word8]
S.unpackAppendBytesLazy ByteString
c (ByteString -> [Word8]
unpackBytes ByteString
cs)
unpackChars :: ByteString -> [Char]
unpackChars :: ByteString -> String
unpackChars Empty = []
unpackChars (Chunk c :: ByteString
c cs :: ByteString
cs) = ByteString -> ShowS
S.unpackAppendCharsLazy ByteString
c (ByteString -> String
unpackChars ByteString
cs)
invariant :: ByteString -> Bool
invariant :: ByteString -> Bool
invariant Empty = Bool
True
invariant (Chunk (S.PS _ _ len :: Int
len) cs :: ByteString
cs) = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& ByteString -> Bool
invariant ByteString
cs
checkInvariant :: ByteString -> ByteString
checkInvariant :: ByteString -> ByteString
checkInvariant Empty = ByteString
Empty
checkInvariant (Chunk c :: ByteString
c@(S.PS _ _ len :: Int
len) cs :: ByteString
cs)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
$ "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)
chunk :: S.ByteString -> ByteString -> ByteString
chunk :: ByteString -> ByteString -> ByteString
chunk c :: ByteString
c@(S.PS _ _ len :: Int
len) cs :: ByteString
cs | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ByteString
cs
| Bool
otherwise = ByteString -> ByteString -> ByteString
Chunk ByteString
c ByteString
cs
{-# INLINE chunk #-}
foldrChunks :: (S.ByteString -> a -> a) -> a -> ByteString -> a
foldrChunks :: (ByteString -> a -> a) -> a -> ByteString -> a
foldrChunks f :: ByteString -> a -> a
f z :: a
z = ByteString -> a
go
where go :: ByteString -> a
go Empty = a
z
go (Chunk c :: ByteString
c cs :: ByteString
cs) = ByteString -> a -> a
f ByteString
c (ByteString -> a
go ByteString
cs)
{-# INLINE foldrChunks #-}
foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a
foldlChunks :: (a -> ByteString -> a) -> a -> ByteString -> a
foldlChunks f :: a -> ByteString -> a
f z :: a
z = a -> ByteString -> a
go a
z
where go :: a -> ByteString -> a
go a :: a
a _ | a
a a -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = a
forall a. HasCallStack => a
undefined
go a :: a
a Empty = a
a
go a :: a
a (Chunk c :: ByteString
c cs :: ByteString
cs) = a -> ByteString -> a
go (a -> ByteString -> a
f a
a ByteString
c) ByteString
cs
{-# INLINE foldlChunks #-}
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = 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 = 1024
smallChunkSize :: Int
smallChunkSize :: Int
smallChunkSize = 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 = 1024
chunkOverhead :: Int
chunkOverhead :: Int
chunkOverhead = 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)
eq :: ByteString -> ByteString -> Bool
eq :: ByteString -> ByteString -> Bool
eq Empty Empty = Bool
True
eq Empty _ = Bool
False
eq _ Empty = Bool
False
eq (Chunk a :: ByteString
a as :: ByteString
as) (Chunk b :: ByteString
b bs :: 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
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)
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
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 Empty Empty = Ordering
EQ
cmp Empty _ = Ordering
LT
cmp _ Empty = Ordering
GT
cmp (Chunk a :: ByteString
a as :: ByteString
as) (Chunk b :: ByteString
b bs :: 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
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
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)
result :: Ordering
result -> Ordering
result
EQ -> case ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
a ByteString
b of
EQ -> ByteString -> ByteString -> Ordering
cmp ByteString
as ByteString
bs
result :: Ordering
result -> Ordering
result
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
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
result :: Ordering
result -> Ordering
result
append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append xs :: ByteString
xs ys :: 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 css0 :: [ByteString]
css0 = [ByteString] -> ByteString
to [ByteString]
css0
where
go :: ByteString -> [ByteString] -> ByteString
go Empty css :: [ByteString]
css = [ByteString] -> ByteString
to [ByteString]
css
go (Chunk c :: ByteString
c cs :: ByteString
cs) css :: [ByteString]
css = ByteString -> ByteString -> ByteString
Chunk ByteString
c (ByteString -> [ByteString] -> ByteString
go ByteString
cs [ByteString]
css)
to :: [ByteString] -> ByteString
to [] = ByteString
Empty
to (cs :: ByteString
cs:css :: [ByteString]
css) = ByteString -> [ByteString] -> ByteString
go ByteString
cs [ByteString]
css