module Data.ByteString.Lazy.Internal (
ByteString(..),
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 as S
import Data.Word (Word8)
import Foreign.Ptr (plusPtr)
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.Typeable (Typeable)
import Data.Data (Data(..), mkNoRepType)
import GHC.Exts (IsList(..))
import qualified Language.Haskell.TH.Syntax as TH
data ByteString = Empty | Chunk !S.ByteString ByteString
deriving (Typeable, TH.Lift)
type LazyByteString = ByteString
instance Eq ByteString where
(==) = eq
instance Ord ByteString where
compare = cmp
instance Semigroup ByteString where
(<>) = append
sconcat (b:|bs) = concat (b:bs)
stimes = times
instance Monoid ByteString where
mempty = Empty
mappend = (<>)
mconcat = concat
instance NFData ByteString where
rnf Empty = ()
rnf (Chunk _ b) = rnf b
instance Show ByteString where
showsPrec p ps r = showsPrec p (unpackChars ps) r
instance Read ByteString where
readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]
instance IsList ByteString where
type Item ByteString = Word8
fromList = packBytes
toList = unpackBytes
instance IsString ByteString where
fromString = packChars
instance Data ByteString where
gfoldl f z txt = z packBytes `f` unpackBytes txt
toConstr _ = error "Data.ByteString.Lazy.ByteString.toConstr"
gunfold _ _ = error "Data.ByteString.Lazy.ByteString.gunfold"
dataTypeOf _ = mkNoRepType "Data.ByteString.Lazy.ByteString"
packBytes :: [Word8] -> ByteString
packBytes cs0 =
packChunks 32 cs0
where
packChunks n cs = case S.packUptoLenBytes n cs of
(bs, []) -> chunk bs Empty
(bs, cs') -> Chunk bs (packChunks (min (n * 2) smallChunkSize) cs')
packChars :: [Char] -> ByteString
packChars cs0 = packChunks 32 cs0
where
packChunks n cs = case S.packUptoLenChars n cs of
(bs, []) -> chunk bs Empty
(bs, cs') -> Chunk bs (packChunks (min (n * 2) smallChunkSize) cs')
unpackBytes :: ByteString -> [Word8]
unpackBytes Empty = []
unpackBytes (Chunk c cs) = S.unpackAppendBytesLazy c (unpackBytes cs)
unpackChars :: ByteString -> [Char]
unpackChars Empty = []
unpackChars (Chunk c cs) = S.unpackAppendCharsLazy c (unpackChars cs)
invariant :: ByteString -> Bool
invariant Empty = True
invariant (Chunk (S.BS _ len) cs) = len > 0 && invariant cs
checkInvariant :: ByteString -> ByteString
checkInvariant Empty = Empty
checkInvariant (Chunk c@(S.BS _ len) cs)
| len > 0 = Chunk c (checkInvariant cs)
| otherwise = error $ "Data.ByteString.Lazy: invariant violation:"
++ show (Chunk c cs)
chunk :: S.ByteString -> ByteString -> ByteString
chunk c@(S.BS _ len) cs | len == 0 = cs
| otherwise = Chunk c cs
foldrChunks :: (S.ByteString -> a -> a) -> a -> ByteString -> a
foldrChunks f z = go
where go Empty = z
go (Chunk c cs) = f c (go cs)
foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a
foldlChunks f = go
where go !a Empty = a
go !a (Chunk c cs) = go (f a c) cs
defaultChunkSize :: Int
defaultChunkSize = 32 * k chunkOverhead
where k = 1024
smallChunkSize :: Int
smallChunkSize = 4 * k chunkOverhead
where k = 1024
chunkOverhead :: Int
chunkOverhead = 2 * sizeOf (undefined :: Int)
eq :: ByteString -> ByteString -> Bool
eq Empty Empty = True
eq Empty _ = False
eq _ Empty = False
eq (Chunk a@(S.BS ap al) as) (Chunk b@(S.BS bp bl) bs) =
case compare al bl of
LT -> a == S.BS bp al && eq as (Chunk (S.BS (S.plusForeignPtr bp al) (bl al)) bs)
EQ -> a == b && eq as bs
GT -> S.BS ap bl == b && eq (Chunk (S.BS (S.plusForeignPtr ap bl) (al bl)) as) bs
cmp :: ByteString -> ByteString -> Ordering
cmp Empty Empty = EQ
cmp Empty _ = LT
cmp _ Empty = GT
cmp (Chunk a@(S.BS ap al) as) (Chunk b@(S.BS bp bl) bs) =
case compare al bl of
LT -> case compare a (S.BS bp al) of
EQ -> cmp as (Chunk (S.BS (S.plusForeignPtr bp al) (bl al)) bs)
result -> result
EQ -> case compare a b of
EQ -> cmp as bs
result -> result
GT -> case compare (S.BS ap bl) b of
EQ -> cmp (Chunk (S.BS (S.plusForeignPtr ap bl) (al bl)) as) bs
result -> result
append :: ByteString -> ByteString -> ByteString
append xs ys = foldrChunks Chunk ys xs
concat :: [ByteString] -> ByteString
concat = to
where
go Empty css = to css
go (Chunk c cs) css = Chunk c (go cs css)
to [] = Empty
to (cs:css) = go cs css
times :: Integral a => a -> ByteString -> ByteString
times 0 _ = Empty
times n lbs0
| n < 0 = error "stimes: non-negative multiplier expected"
| otherwise = case lbs0 of
Empty -> Empty
Chunk bs lbs -> Chunk bs (go lbs)
where
go Empty = times (n1) lbs0
go (Chunk c cs) = Chunk c (go cs)
fromStrict :: S.ByteString -> ByteString
fromStrict (S.BS _ 0) = Empty
fromStrict bs = Chunk bs Empty
toStrict :: ByteString -> S.ByteString
toStrict = \cs -> goLen0 cs cs
where
goLen0 _ Empty = S.BS S.nullForeignPtr 0
goLen0 cs0 (Chunk (S.BS _ 0) cs) = goLen0 cs0 cs
goLen0 cs0 (Chunk c cs) = goLen1 cs0 c cs
goLen1 _ bs Empty = bs
goLen1 cs0 bs (Chunk (S.BS _ 0) cs) = goLen1 cs0 bs cs
goLen1 cs0 (S.BS _ bl) (Chunk (S.BS _ cl) cs) =
goLen cs0 (S.checkedAdd "Lazy.concat" bl cl) cs
goLen cs0 !total (Chunk (S.BS _ cl) cs) =
goLen cs0 (S.checkedAdd "Lazy.concat" total cl) cs
goLen cs0 total Empty =
S.unsafeCreate total $ \ptr -> goCopy cs0 ptr
goCopy Empty !_ = return ()
goCopy (Chunk (S.BS _ 0 ) cs) !ptr = goCopy cs ptr
goCopy (Chunk (S.BS fp len) cs) !ptr =
S.unsafeWithForeignPtr fp $ \p -> do
S.memcpy ptr p len
goCopy cs (ptr `plusPtr` len)