{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}

{- | Chunks of bytes. This is useful as a target for a builder
or as a way to read a large amount of whose size is unknown
in advance. Structurally, this type is similar to
@Data.ByteString.Lazy.ByteString@. However, the type in this
module is strict in its spine. Additionally, none of the
@Handle@ functions perform lazy I\/O.
-}
module Data.Bytes.Chunks
  ( -- * Types
    Chunks (..)

    -- * Properties
  , length
  , null

    -- * Manipulate
  , cons
  , concat
  , concatPinned
  , concatU
  , concatPinnedU
  , concatByteString
  , reverse
  , reverseOnto
  , replicate
  , replicateByte

    -- * Folds
  , foldl'

    -- * Splitting
  , split

    -- * Hashing
  , fnv1a32
  , fnv1a64

    -- * Create
  , fromBytes
  , fromByteArray

    -- * Copy to buffer
  , unsafeCopy

    -- * I\/O with Handles
  , hGetContents
  , readFile
  , hPut
  , writeFile
  ) where

import Prelude hiding (Foldable (..), concat, readFile, replicate, reverse, writeFile)

import Control.Exception (IOException, catch)
import Control.Monad.ST.Run (runIntByteArrayST)
import Data.Bits (xor)
import Data.ByteString (ByteString)
import Data.Bytes.Types (Bytes (Bytes))
import Data.Primitive (ByteArray (..), MutableByteArray (..))
import Data.Word (Word32, Word64, Word8)
import GHC.Exts (ByteArray#, Int (I#), Int#, MutableByteArray#, State#, (+#))
import GHC.ST (ST (..))
import System.IO (Handle, IOMode (ReadMode, WriteMode), hFileSize, withBinaryFile)

import qualified Data.Bytes.Byte as Byte
import qualified Data.Bytes.IO as IO
import qualified Data.Bytes.Pure as Bytes
import qualified Data.Bytes.Types as B
import qualified Data.Primitive as PM
import qualified GHC.Exts as Exts

-- | A cons-list of byte sequences.
data Chunks
  = ChunksCons {-# UNPACK #-} !Bytes !Chunks
  | ChunksNil
  deriving stock (Int -> Chunks -> ShowS
[Chunks] -> ShowS
Chunks -> String
(Int -> Chunks -> ShowS)
-> (Chunks -> String) -> ([Chunks] -> ShowS) -> Show Chunks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Chunks -> ShowS
showsPrec :: Int -> Chunks -> ShowS
$cshow :: Chunks -> String
show :: Chunks -> String
$cshowList :: [Chunks] -> ShowS
showList :: [Chunks] -> ShowS
Show)

instance Semigroup Chunks where
  Chunks
ChunksNil <> :: Chunks -> Chunks -> Chunks
<> Chunks
a = Chunks
a
  cs :: Chunks
cs@(ChunksCons Bytes
_ Chunks
_) <> Chunks
ChunksNil = Chunks
cs
  as :: Chunks
as@(ChunksCons Bytes
_ Chunks
_) <> bs :: Chunks
bs@(ChunksCons Bytes
_ Chunks
_) =
    Chunks -> Chunks -> Chunks
reverseOnto Chunks
bs (Chunks -> Chunks
reverse Chunks
as)

instance Monoid Chunks where
  mempty :: Chunks
mempty = Chunks
ChunksNil

-- | This uses @concat@ to form an equivalence class.
instance Eq Chunks where
  -- TODO: There is a more efficient way to do this, but
  -- it is tedious.
  Chunks
a == :: Chunks -> Chunks -> Bool
== Chunks
b = Chunks -> Bytes
concat Chunks
a Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Chunks -> Bytes
concat Chunks
b

-- | Add a byte sequence to the beginning.
cons :: Bytes -> Chunks -> Chunks
{-# INLINE cons #-}
cons :: Bytes -> Chunks -> Chunks
cons = Bytes -> Chunks -> Chunks
ChunksCons

{- | Repeat the byte sequence over and over. Returns empty chunks when given
a negative repetition count.
-}
replicate ::
  Bytes ->
  -- | Number of times to repeat the sequence.
  Int ->
  Chunks
replicate :: Bytes -> Int -> Chunks
replicate !b :: Bytes
b@(Bytes ByteArray
_ Int
_ Int
len) !Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Chunks
ChunksNil
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Chunks
ChunksNil
  | Bool
otherwise = Int -> Chunks -> Chunks
go Int
n Chunks
ChunksNil
 where
  -- Implementation note: We do not have to reverse the chunks at the end.
  go :: Int -> Chunks -> Chunks
go Int
i !Chunks
acc = case Int
i of
    Int
0 -> Chunks
acc
    Int
_ -> Int -> Chunks -> Chunks
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Bytes -> Chunks -> Chunks
ChunksCons Bytes
b Chunks
acc)

{- | Repeat the byte over and over. This builds a single byte array that
is at most 64KiB and shares that across every @ChunksCons@ cell.

An as example, creating a 2GiB chunks this way would use 64KiB for the
byte array, and there would be the additional overhead of the 2^15
@ChunksCons@ data constructors. On a 64-bit platform, @ChunksCons@
takes 40 bytes, so the total memory consumption would be
@2^16 + 40 * 2^15@, which is roughly 1.37MB. The same reasoning
shows that it takes about 83.95MB to represent a 128GiB chunks.

The size of the shared payload is an implementation detail. Do not
rely on this function producing 64KiB chunks. The implementation might
one day change to something smarter that minimizes the memory footprint
for very large chunks.
-}
replicateByte ::
  Word8 ->
  -- | Number of times to replicate the byte
  Int ->
  Chunks
replicateByte :: Word8 -> Int -> Chunks
replicateByte !Word8
w !Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Chunks
ChunksNil
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
65536 = Bytes -> Chunks -> Chunks
ChunksCons (Int -> Word8 -> Bytes
Bytes.replicate Int
n Word8
w) Chunks
ChunksNil
  | Bool
otherwise = ByteArray -> Int -> Chunks -> Chunks
go (Int -> Word8 -> ByteArray
Bytes.replicateU Int
65536 Word8
w) Int
n Chunks
ChunksNil
 where
  go :: ByteArray -> Int -> Chunks -> Chunks
go !ByteArray
shared !Int
remaining !Chunks
acc
    | Int
remaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Chunks
acc
    | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
65536 = Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
shared Int
0 Int
remaining) Chunks
acc
    | Bool
otherwise = ByteArray -> Int -> Chunks -> Chunks
go ByteArray
shared (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65536) (Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
shared Int
0 Int
65536) Chunks
acc)

-- | Are there any bytes in the chunked byte sequences?
null :: Chunks -> Bool
null :: Chunks -> Bool
null = Chunks -> Bool
go
 where
  go :: Chunks -> Bool
go Chunks
ChunksNil = Bool
True
  go (ChunksCons (Bytes ByteArray
_ Int
_ Int
len) Chunks
xs) = case Int
len of
    Int
0 -> Chunks -> Bool
go Chunks
xs
    Int
_ -> Bool
False

{- | Variant of 'concat' that ensure that the resulting byte
sequence is pinned memory.
-}
concatPinned :: Chunks -> Bytes
concatPinned :: Chunks -> Bytes
concatPinned Chunks
x = case Chunks
x of
  Chunks
ChunksNil -> Bytes
Bytes.emptyPinned
  ChunksCons Bytes
b Chunks
y -> case Chunks
y of
    Chunks
ChunksNil -> Bytes -> Bytes
Bytes.pin Bytes
b
    ChunksCons Bytes
c Chunks
z -> case Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatPinnedFollowing2 Bytes
b Bytes
c Chunks
z of
      (# Int#
len, ByteArray#
r #) -> ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
r) Int
0 (Int# -> Int
I# Int#
len)

-- | Concatenate chunks into a strict bytestring.
concatByteString :: Chunks -> ByteString
concatByteString :: Chunks -> ByteString
concatByteString Chunks
c = Bytes -> ByteString
Bytes.pinnedToByteString (Chunks -> Bytes
concatPinned Chunks
c)

-- | Concatenate chunks into a single contiguous byte sequence.
concat :: Chunks -> Bytes
concat :: Chunks -> Bytes
concat Chunks
x = case Chunks
x of
  Chunks
ChunksNil -> Bytes
Bytes.empty
  ChunksCons Bytes
b Chunks
y -> case Chunks
y of
    Chunks
ChunksNil -> Bytes
b
    ChunksCons Bytes
c Chunks
z -> case Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatFollowing2 Bytes
b Bytes
c Chunks
z of
      (# Int#
len, ByteArray#
r #) -> ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
r) Int
0 (Int# -> Int
I# Int#
len)

-- | Variant of 'concat' that returns an unsliced byte sequence.
concatU :: Chunks -> ByteArray
concatU :: Chunks -> ByteArray
concatU Chunks
x = case Chunks
x of
  Chunks
ChunksNil -> ByteArray
forall a. Monoid a => a
mempty
  ChunksCons Bytes
b Chunks
y -> case Chunks
y of
    Chunks
ChunksNil -> Bytes -> ByteArray
Bytes.toByteArray Bytes
b
    ChunksCons Bytes
c Chunks
z -> case Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatFollowing2 Bytes
b Bytes
c Chunks
z of
      (# Int#
_, ByteArray#
r #) -> ByteArray# -> ByteArray
ByteArray ByteArray#
r

-- | Variant of 'concatPinned' that returns an unsliced pinned byte sequence.
concatPinnedU :: Chunks -> ByteArray
concatPinnedU :: Chunks -> ByteArray
concatPinnedU Chunks
x = case Chunks
x of
  Chunks
ChunksNil -> ByteArray
Bytes.emptyPinnedU
  ChunksCons Bytes
b Chunks
y -> case Chunks
y of
    Chunks
ChunksNil -> Bytes -> ByteArray
Bytes.toPinnedByteArray Bytes
b
    ChunksCons Bytes
c Chunks
z -> case Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatPinnedFollowing2 Bytes
b Bytes
c Chunks
z of
      (# Int#
_, ByteArray#
r #) -> ByteArray# -> ByteArray
ByteArray ByteArray#
r

concatFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatFollowing2 = (forall s. Int -> ST s (MutableByteArray s))
-> Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
internalConcatFollowing2 Int -> ST s (MutableByteArray s)
Int -> ST s (MutableByteArray (PrimState (ST s)))
forall s. Int -> ST s (MutableByteArray s)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray

concatPinnedFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatPinnedFollowing2 :: Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
concatPinnedFollowing2 = (forall s. Int -> ST s (MutableByteArray s))
-> Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
internalConcatFollowing2 Int -> ST s (MutableByteArray s)
Int -> ST s (MutableByteArray (PrimState (ST s)))
forall s. Int -> ST s (MutableByteArray s)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray

internalConcatFollowing2 ::
  (forall s. Int -> ST s (MutableByteArray s)) ->
  Bytes ->
  Bytes ->
  Chunks ->
  (# Int#, ByteArray# #)
{-# INLINE internalConcatFollowing2 #-}
internalConcatFollowing2 :: (forall s. Int -> ST s (MutableByteArray s))
-> Bytes -> Bytes -> Chunks -> (# Int#, ByteArray# #)
internalConcatFollowing2
  forall s. Int -> ST s (MutableByteArray s)
allocate
  (Bytes {$sel:array:Bytes :: Bytes -> ByteArray
array = ByteArray
c, $sel:offset:Bytes :: Bytes -> Int
offset = Int
coff, $sel:length:Bytes :: Bytes -> Int
length = Int
szc})
  (Bytes {$sel:array:Bytes :: Bytes -> ByteArray
array = ByteArray
d, $sel:offset:Bytes :: Bytes -> Int
offset = Int
doff, $sel:length:Bytes :: Bytes -> Int
length = Int
szd})
  Chunks
ds =
    let !(I# Int#
x, ByteArray ByteArray#
y) = (forall s. ST s (Int, ByteArray)) -> (Int, ByteArray)
runIntByteArrayST ((forall s. ST s (Int, ByteArray)) -> (Int, ByteArray))
-> (forall s. ST s (Int, ByteArray)) -> (Int, ByteArray)
forall a b. (a -> b) -> a -> b
$ do
          let !szboth :: Int
szboth = Int
szc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szd
              !len :: Int
len = Int -> Chunks -> Int
chunksLengthGo Int
szboth Chunks
ds
          MutableByteArray s
dst <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
allocate Int
len
          MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 ByteArray
c Int
coff Int
szc
          MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
szc ByteArray
d Int
doff Int
szd
          -- Note: len2 will always be the same as len.
          !Int
len2 <- MutableByteArray s -> Int -> Chunks -> ST s Int
forall s. MutableByteArray s -> Int -> Chunks -> ST s Int
unsafeCopy MutableByteArray s
dst Int
szboth Chunks
ds
          ByteArray
result <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
          (Int, ByteArray) -> ST s (Int, ByteArray)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
len2, ByteArray
result)
     in (# Int#
x, ByteArray#
y #)

-- | The total number of bytes in all the chunks.
length :: Chunks -> Int
length :: Chunks -> Int
length = Int -> Chunks -> Int
chunksLengthGo Int
0

chunksLengthGo :: Int -> Chunks -> Int
chunksLengthGo :: Int -> Chunks -> Int
chunksLengthGo !Int
n Chunks
ChunksNil = Int
n
chunksLengthGo !Int
n (ChunksCons (Bytes {$sel:length:Bytes :: Bytes -> Int
B.length = Int
len}) Chunks
cs) =
  Int -> Chunks -> Int
chunksLengthGo (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Chunks
cs

{- | Copy the contents of the chunks into a mutable array.
Precondition: The destination must have enough space to
house the contents. This is not checked.
-}
unsafeCopy ::
  -- | Destination
  MutableByteArray s ->
  -- | Destination offset
  Int ->
  -- | Source
  Chunks ->
  -- | Returns the next index into the destination after the payload
  ST s Int
{-# INLINE unsafeCopy #-}
unsafeCopy :: forall s. MutableByteArray s -> Int -> Chunks -> ST s Int
unsafeCopy (MutableByteArray MutableByteArray# s
dst) (I# Int#
off) Chunks
cs =
  STRep s Int -> ST s Int
forall s a. STRep s a -> ST s a
ST
    ( \State# s
s0 -> case MutableByteArray# s
-> Int# -> Chunks -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s
-> Int# -> Chunks -> State# s -> (# State# s, Int# #)
copy# MutableByteArray# s
dst Int#
off Chunks
cs State# s
s0 of
        (# State# s
s1, Int#
nextOff #) -> (# State# s
s1, Int# -> Int
I# Int#
nextOff #)
    )

copy# :: MutableByteArray# s -> Int# -> Chunks -> State# s -> (# State# s, Int# #)
copy# :: forall s.
MutableByteArray# s
-> Int# -> Chunks -> State# s -> (# State# s, Int# #)
copy# MutableByteArray# s
_ Int#
off Chunks
ChunksNil State# s
s0 = (# State# s
s0, Int#
off #)
copy# MutableByteArray# s
marr Int#
off (ChunksCons (Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
B.array, Int
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
B.offset, $sel:length:Bytes :: Bytes -> Int
B.length = Int
len}) Chunks
cs) State# s
s0 =
  case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyByteArray# (ByteArray -> ByteArray#
unBa ByteArray
array) (Int -> Int#
unI Int
offset) MutableByteArray# s
marr Int#
off (Int -> Int#
unI Int
len) State# s
s0 of
    State# s
s1 -> MutableByteArray# s
-> Int# -> Chunks -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s
-> Int# -> Chunks -> State# s -> (# State# s, Int# #)
copy# MutableByteArray# s
marr (Int#
off Int# -> Int# -> Int#
+# Int -> Int#
unI Int
len) Chunks
cs State# s
s1

-- | Reverse chunks but not the bytes within each chunk.
reverse :: Chunks -> Chunks
reverse :: Chunks -> Chunks
reverse = Chunks -> Chunks -> Chunks
reverseOnto Chunks
ChunksNil

{- | Variant of 'reverse' that allows the caller to provide
an initial list of chunks that the reversed chunks will
be pushed onto.
-}
reverseOnto :: Chunks -> Chunks -> Chunks
reverseOnto :: Chunks -> Chunks -> Chunks
reverseOnto !Chunks
x Chunks
ChunksNil = Chunks
x
reverseOnto !Chunks
x (ChunksCons Bytes
y Chunks
ys) =
  Chunks -> Chunks -> Chunks
reverseOnto (Bytes -> Chunks -> Chunks
ChunksCons Bytes
y Chunks
x) Chunks
ys

unI :: Int -> Int#
{-# INLINE unI #-}
unI :: Int -> Int#
unI (I# Int#
i) = Int#
i

unBa :: ByteArray -> ByteArray#
{-# INLINE unBa #-}
unBa :: ByteArray -> ByteArray#
unBa (ByteArray ByteArray#
x) = ByteArray#
x

-- | Read a handle's entire contents strictly into chunks.
hGetContents :: Handle -> IO Chunks
hGetContents :: Handle -> IO Chunks
hGetContents !Handle
h = Chunks -> Handle -> IO Chunks
hGetContentsCommon Chunks
ChunksNil Handle
h

-- | Read a handle's entire contents strictly into chunks.
hGetContentsHint :: Int -> Handle -> IO Chunks
hGetContentsHint :: Int -> Handle -> IO Chunks
hGetContentsHint !Int
hint !Handle
h = do
  Bytes
c <- Handle -> Int -> IO Bytes
IO.hGet Handle
h Int
hint
  let !r :: Chunks
r = Bytes -> Chunks -> Chunks
ChunksCons Bytes
c Chunks
ChunksNil
  if Bytes -> Int
Bytes.length Bytes
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hint
    then Chunks -> IO Chunks
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunks
r
    else Chunks -> Handle -> IO Chunks
hGetContentsCommon Chunks
r Handle
h

hGetContentsCommon ::
  Chunks -> -- reversed chunks
  Handle ->
  IO Chunks
hGetContentsCommon :: Chunks -> Handle -> IO Chunks
hGetContentsCommon !Chunks
acc0 !Handle
h = Chunks -> IO Chunks
go Chunks
acc0
 where
  go :: Chunks -> IO Chunks
go !Chunks
acc = do
    Bytes
c <- Handle -> Int -> IO Bytes
IO.hGet Handle
h Int
chunkSize
    let !r :: Chunks
r = Bytes -> Chunks -> Chunks
ChunksCons Bytes
c Chunks
acc
    if Bytes -> Int
Bytes.length Bytes
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chunkSize
      then Chunks -> IO Chunks
go Chunks
r
      else Chunks -> IO Chunks
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunks -> IO Chunks) -> Chunks -> IO Chunks
forall a b. (a -> b) -> a -> b
$! Chunks -> Chunks
reverse Chunks
r

{- | Read an entire file strictly into chunks. If reading from a
regular file, this makes an effort read the file into a single
chunk.
-}
readFile :: FilePath -> IO Chunks
readFile :: String -> IO Chunks
readFile String
f = String -> IOMode -> (Handle -> IO Chunks) -> IO Chunks
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
ReadMode ((Handle -> IO Chunks) -> IO Chunks)
-> (Handle -> IO Chunks) -> IO Chunks
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  -- Implementation copied from bytestring.
  -- hFileSize fails if file is not regular file (like
  -- /dev/null). Catch exception and try reading anyway.
  Integer
filesz <- IO Integer -> (IOException -> IO Integer) -> IO Integer
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> IO Integer
hFileSize Handle
h) IOException -> IO Integer
useZeroIfNotRegularFile
  let hint :: Int
hint = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
255) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Int -> Handle -> IO Chunks
hGetContentsHint Int
hint Handle
h
 where
  -- Our initial size is one bigger than the file size so that in the
  -- typical case we will read the whole file in one go and not have
  -- to allocate any more chunks. We'll still do the right thing if the
  -- file size is 0 or is changed before we do the read.

  useZeroIfNotRegularFile :: IOException -> IO Integer
  useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile IOException
_ = Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0

chunkSize :: Int
chunkSize :: Int
chunkSize = Int
16384 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16

-- | Create a list of chunks with a single chunk.
fromBytes :: Bytes -> Chunks
fromBytes :: Bytes -> Chunks
fromBytes !Bytes
b = Bytes -> Chunks -> Chunks
ChunksCons Bytes
b Chunks
ChunksNil

-- | Variant of 'fromBytes' where the single chunk is unsliced.
fromByteArray :: ByteArray -> Chunks
fromByteArray :: ByteArray -> Chunks
fromByteArray !ByteArray
b = Bytes -> Chunks
fromBytes (ByteArray -> Bytes
Bytes.fromByteArray ByteArray
b)

-- | Left fold over all bytes in the chunks, strict in the accumulator.
foldl' :: (a -> Word8 -> a) -> a -> Chunks -> a
{-# INLINE foldl' #-}
foldl' :: forall a. (a -> Word8 -> a) -> a -> Chunks -> a
foldl' a -> Word8 -> a
g = a -> Chunks -> a
go
 where
  go :: a -> Chunks -> a
go !a
a Chunks
ChunksNil = a
a
  go !a
a (ChunksCons Bytes
c Chunks
cs) = a -> Chunks -> a
go ((a -> Word8 -> a) -> a -> Bytes -> a
forall a. (a -> Word8 -> a) -> a -> Bytes -> a
Bytes.foldl' a -> Word8 -> a
g a
a Bytes
c) Chunks
cs

-- | Hash byte sequence with 32-bit variant of FNV-1a.
fnv1a32 :: Chunks -> Word32
fnv1a32 :: Chunks -> Word32
fnv1a32 !Chunks
b =
  (Word32 -> Word8 -> Word32) -> Word32 -> Chunks -> Word32
forall a. (a -> Word8 -> a) -> a -> Chunks -> a
foldl'
    ( \Word32
acc Word8
w -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Word32 Word8
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
acc) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
0x01000193
    )
    Word32
0x811c9dc5
    Chunks
b

-- | Hash byte sequence with 64-bit variant of FNV-1a.
fnv1a64 :: Chunks -> Word64
fnv1a64 :: Chunks -> Word64
fnv1a64 !Chunks
b =
  (Word64 -> Word8 -> Word64) -> Word64 -> Chunks -> Word64
forall a. (a -> Word8 -> a) -> a -> Chunks -> a
foldl'
    ( \Word64
acc Word8
w -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Word64 Word8
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
acc) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
0x00000100000001B3
    )
    Word64
0xcbf29ce484222325
    Chunks
b

{- | Outputs 'Chunks' to the specified 'Handle'. This is implemented
with 'IO.hPut'.
-}
hPut :: Handle -> Chunks -> IO ()
hPut :: Handle -> Chunks -> IO ()
hPut Handle
h = Chunks -> IO ()
go
 where
  go :: Chunks -> IO ()
go Chunks
ChunksNil = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go (ChunksCons Bytes
c Chunks
cs) = Handle -> Bytes -> IO ()
IO.hPut Handle
h Bytes
c IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Chunks -> IO ()
go Chunks
cs

{- | Write 'Chunks' to a file, replacing the previous contents of
the file.
-}
writeFile :: FilePath -> Chunks -> IO ()
writeFile :: String -> Chunks -> IO ()
writeFile String
path Chunks
cs = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
WriteMode (\Handle
h -> Handle -> Chunks -> IO ()
hPut Handle
h Chunks
cs)

{- | Break chunks of bytes into contiguous pieces separated by the
byte argument. This is a good producer for list fusion. For this
function to perform well, each chunk should contain multiple separators.
Any piece that spans multiple chunks must be copied.
-}
split :: Word8 -> Chunks -> [Bytes]
{-# INLINE split #-}
split :: Word8 -> Chunks -> [Bytes]
split !Word8
w !Chunks
cs0 =
  (forall b. (Bytes -> b -> b) -> b -> b) -> [Bytes]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build
    ( \Bytes -> b -> b
g b
x0 ->
        -- It is possible to optimize for the common case where a
        -- piece does not span multiple chunks. However, such an
        -- optimization would actually cause this to tail call in
        -- two places rather than one and may actually adversely
        -- affect performance. It hasn't been benchmarked.
        let go :: Chunks -> b
go !Chunks
cs = case Chunks -> Word8 -> Chunks -> (Chunks, Chunks)
splitOnto Chunks
ChunksNil Word8
w Chunks
cs of
              (Chunks
hd, Chunks
tl) ->
                let !x :: Bytes
x = Chunks -> Bytes
concat (Chunks -> Chunks
reverse Chunks
hd)
                 in case Chunks
tl of
                      Chunks
ChunksNil -> b
x0
                      Chunks
_ -> Bytes -> b -> b
g Bytes
x (Chunks -> b
go Chunks
tl)
         in Chunks -> b
go Chunks
cs0
    )

splitOnto :: Chunks -> Word8 -> Chunks -> (Chunks, Chunks)
{-# INLINE splitOnto #-}
splitOnto :: Chunks -> Word8 -> Chunks -> (Chunks, Chunks)
splitOnto !Chunks
acc0 !Word8
w !Chunks
cs0 = Chunks -> Chunks -> (Chunks, Chunks)
go Chunks
acc0 Chunks
cs0
 where
  go :: Chunks -> Chunks -> (Chunks, Chunks)
go !Chunks
acc Chunks
ChunksNil = (Chunks
acc, Chunks
ChunksNil)
  go !Chunks
acc (ChunksCons Bytes
b Chunks
bs) = case Word8 -> Bytes -> Maybe (Bytes, Bytes)
Byte.split1 Word8
w Bytes
b of
    Maybe (Bytes, Bytes)
Nothing -> Chunks -> Chunks -> (Chunks, Chunks)
go (Bytes -> Chunks -> Chunks
ChunksCons Bytes
b Chunks
acc) Chunks
bs
    Just (Bytes
hd, Bytes
tl) ->
      let !r1 :: Chunks
r1 = Bytes -> Chunks -> Chunks
ChunksCons Bytes
hd Chunks
acc
          !r2 :: Chunks
r2 = Bytes -> Chunks -> Chunks
ChunksCons Bytes
tl Chunks
bs
       in (Chunks
r1, Chunks
r2)