{-# language BangPatterns #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UnboxedTuples #-}
module Data.Bytes.Chunks
(
Chunks(..)
, length
, null
, concat
, concatPinned
, concatU
, concatPinnedU
, concatByteString
, reverse
, reverseOnto
, foldl'
, split
, fnv1a32
, fnv1a64
, fromBytes
, fromByteArray
, unsafeCopy
, hGetContents
, readFile
, hPut
, writeFile
) where
import Prelude hiding (Foldable(..),concat,reverse,readFile,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 (Word8,Word32,Word64)
import GHC.Exts (ByteArray#,MutableByteArray#)
import GHC.Exts (Int#,State#,Int(I#),(+#))
import GHC.ST (ST(..))
import System.IO (Handle,hFileSize,IOMode(ReadMode,WriteMode),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
data Chunks
= ChunksCons {-# UNPACK #-} !Bytes !Chunks
| ChunksNil
deriving stock (Int -> Chunks -> ShowS
[Chunks] -> ShowS
Chunks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chunks] -> ShowS
$cshowList :: [Chunks] -> ShowS
show :: Chunks -> String
$cshow :: Chunks -> String
showsPrec :: Int -> Chunks -> ShowS
$cshowsPrec :: Int -> 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
instance Eq Chunks where
Chunks
a == :: Chunks -> Chunks -> Bool
== Chunks
b = Chunks -> Bytes
concat Chunks
a forall a. Eq a => a -> a -> Bool
== Chunks -> Bytes
concat Chunks
b
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
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)
concatByteString :: Chunks -> ByteString
concatByteString :: Chunks -> ByteString
concatByteString Chunks
c = Bytes -> ByteString
Bytes.pinnedToByteString (Chunks -> Bytes
concatPinned Chunks
c)
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)
concatU :: Chunks -> ByteArray
concatU :: Chunks -> ByteArray
concatU Chunks
x = case Chunks
x of
Chunks
ChunksNil -> 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
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 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 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 a b. (a -> b) -> a -> b
$ do
let !szboth :: Int
szboth = Int
szc forall a. Num a => a -> a -> a
+ Int
szd
!len :: Int
len = Int -> Chunks -> Int
chunksLengthGo Int
szboth Chunks
ds
MutableByteArray s
dst <- forall s. Int -> ST s (MutableByteArray s)
allocate Int
len
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray s
dst Int
0 ByteArray
c Int
coff Int
szc
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray s
dst Int
szc ByteArray
d Int
doff Int
szd
!Int
len2 <- forall s. MutableByteArray s -> Int -> Chunks -> ST s Int
unsafeCopy MutableByteArray s
dst Int
szboth Chunks
ds
ByteArray
result <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
dst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
len2,ByteArray
result)
in (# Int#
x, ByteArray#
y #)
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 forall a. Num a => a -> a -> a
+ Int
len) Chunks
cs
unsafeCopy ::
MutableByteArray s
-> Int
-> Chunks
-> 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 = forall s a. STRep s a -> ST s a
ST
(\State# s
s0 -> case 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
array :: ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
B.array,Int
offset :: Int
$sel:offset:Bytes :: Bytes -> Int
B.offset,$sel:length:Bytes :: Bytes -> Int
B.length=Int
len}) Chunks
cs) State# s
s0 =
case 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 -> 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 -> Chunks
reverse :: Chunks -> Chunks
reverse = Chunks -> Chunks -> Chunks
reverseOnto Chunks
ChunksNil
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
hGetContents :: Handle -> IO Chunks
hGetContents :: Handle -> IO Chunks
hGetContents !Handle
h = Chunks -> Handle -> IO Chunks
hGetContentsCommon Chunks
ChunksNil Handle
h
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 forall a. Eq a => a -> a -> Bool
== Int
hint
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunks
r
else Chunks -> Handle -> IO Chunks
hGetContentsCommon Chunks
r Handle
h
hGetContentsCommon ::
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 forall a. Eq a => a -> a -> Bool
== Int
chunkSize
then Chunks -> IO Chunks
go Chunks
r
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Chunks -> Chunks
reverse Chunks
r
readFile :: FilePath -> IO Chunks
readFile :: String -> IO Chunks
readFile String
f = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Integer
filesz <- 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesz forall a. Ord a => a -> a -> a
`max` Int
255) forall a. Num a => a -> a -> a
+ Int
1
Int -> Handle -> IO Chunks
hGetContentsHint Int
hint Handle
h
where
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile IOException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
chunkSize :: Int
chunkSize :: Int
chunkSize = Int
16384 forall a. Num a => a -> a -> a
- Int
16
fromBytes :: Bytes -> Chunks
fromBytes :: Bytes -> Chunks
fromBytes !Bytes
b = Bytes -> Chunks -> Chunks
ChunksCons Bytes
b Chunks
ChunksNil
fromByteArray :: ByteArray -> Chunks
fromByteArray :: ByteArray -> Chunks
fromByteArray !ByteArray
b = Bytes -> Chunks
fromBytes (ByteArray -> Bytes
Bytes.fromByteArray ByteArray
b)
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 (forall a. (a -> Word8 -> a) -> a -> Bytes -> a
Bytes.foldl' a -> Word8 -> a
g a
a Bytes
c) Chunks
cs
fnv1a32 :: Chunks -> Word32
fnv1a32 :: Chunks -> Word32
fnv1a32 !Chunks
b = 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 forall a. Bits a => a -> a -> a
`xor` Word32
acc) forall a. Num a => a -> a -> a
* Word32
0x01000193
) Word32
0x811c9dc5 Chunks
b
fnv1a64 :: Chunks -> Word64
fnv1a64 :: Chunks -> Word64
fnv1a64 !Chunks
b = 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 forall a. Bits a => a -> a -> a
`xor` Word64
acc) forall a. Num a => a -> a -> a
* Word64
0x00000100000001B3
) Word64
0xcbf29ce484222325 Chunks
b
hPut :: Handle -> Chunks -> IO ()
hPut :: Handle -> Chunks -> IO ()
hPut Handle
h = Chunks -> IO ()
go where
go :: Chunks -> IO ()
go Chunks
ChunksNil = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go (ChunksCons Bytes
c Chunks
cs) = Handle -> Bytes -> IO ()
IO.hPut Handle
h Bytes
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Chunks -> IO ()
go Chunks
cs
writeFile :: FilePath -> Chunks -> IO ()
writeFile :: String -> Chunks -> IO ()
writeFile String
path Chunks
cs = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
WriteMode (\Handle
h -> Handle -> Chunks -> IO ()
hPut Handle
h Chunks
cs)
split :: Word8 -> Chunks -> [Bytes]
{-# inline split #-}
split :: Word8 -> Chunks -> [Bytes]
split !Word8
w !Chunks
cs0 = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build
(\Bytes -> b -> b
g b
x0 ->
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)