{-# language BangPatterns #-}
{-# language BlockArguments #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language TypeApplications #-}
{-# language UnboxedTuples #-}
module Data.Bytes.Pure
( empty
, emptyPinned
, emptyPinnedU
, pin
, contents
, unsafeCopy
, toByteArray
, toByteArrayClone
, toPinnedByteArray
, toPinnedByteArrayClone
, fromByteArray
, length
, foldlM
, foldrM
, foldl
, foldl'
, foldr
, ifoldl'
, foldr'
, fnv1a32
, fnv1a64
, toByteString
, pinnedToByteString
, fromByteString
) where
import Prelude hiding (length,foldl,foldr)
import Control.Monad.Primitive (PrimState,PrimMonad)
import Control.Monad.ST.Run (runByteArrayST)
import Data.Bits (xor)
import Data.Bytes.Types (Bytes(Bytes))
import Data.ByteString (ByteString)
import Data.Primitive (ByteArray,MutableByteArray)
import Data.Word (Word64,Word32,Word8)
import Foreign.Ptr (Ptr,plusPtr)
import GHC.IO (unsafeIOToST)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Internal as ByteString
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.Primitive as PM
import qualified Data.Primitive.Ptr as PM
import qualified GHC.Exts as Exts
import qualified GHC.ForeignPtr as ForeignPtr
empty :: Bytes
empty :: Bytes
empty = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
forall a. Monoid a => a
mempty Int
0 Int
0
emptyPinned :: Bytes
emptyPinned :: Bytes
emptyPinned = ByteArray -> Int -> Int -> Bytes
Bytes
( (forall s. ST s ByteArray) -> ByteArray
runByteArrayST
(Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
0 ST s (MutableByteArray s)
-> (MutableByteArray s -> ST s ByteArray) -> ST s ByteArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableByteArray s -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray)
) Int
0 Int
0
emptyPinnedU :: ByteArray
emptyPinnedU :: ByteArray
emptyPinnedU = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST
(Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
0 ST s (MutableByteArray s)
-> (MutableByteArray s -> ST s ByteArray) -> ST s ByteArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableByteArray s -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray)
pin :: Bytes -> Bytes
pin :: Bytes -> Bytes
pin b :: Bytes
b@(Bytes ByteArray
arr Int
_ Int
len) = case ByteArray -> Bool
PM.isByteArrayPinned ByteArray
arr of
Bool
True -> Bytes
b
Bool
False -> ByteArray -> Int -> Int -> Bytes
Bytes
( (forall s. ST s ByteArray) -> ByteArray
runByteArrayST do
MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
len
MutableByteArray (PrimState (ST s)) -> Int -> Bytes -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Bytes -> m ()
unsafeCopy MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 Bytes
b
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
0 Int
len
toByteArray :: Bytes -> ByteArray
{-# inline toByteArray #-}
toByteArray :: Bytes -> ByteArray
toByteArray b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len)
| Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, ByteArray -> Int
PM.sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = ByteArray
arr
| Bool
otherwise = Bytes -> ByteArray
toByteArrayClone Bytes
b
toByteArrayClone :: Bytes -> ByteArray
{-# inline toByteArrayClone #-}
toByteArrayClone :: Bytes -> ByteArray
toByteArrayClone (Bytes ByteArray
arr Int
off Int
len) = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
MutableByteArray s
m <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray 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))
m Int
0 ByteArray
arr Int
off Int
len
MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
m
unsafeCopy :: PrimMonad m
=> MutableByteArray (PrimState m)
-> Int
-> Bytes
-> m ()
{-# inline unsafeCopy #-}
unsafeCopy :: MutableByteArray (PrimState m) -> Int -> Bytes -> m ()
unsafeCopy MutableByteArray (PrimState m)
dst Int
dstIx (Bytes ByteArray
src Int
srcIx Int
len) =
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray (PrimState m)
dst Int
dstIx ByteArray
src Int
srcIx Int
len
fromByteArray :: ByteArray -> Bytes
{-# inline fromByteArray #-}
fromByteArray :: ByteArray -> Bytes
fromByteArray ByteArray
b = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
b Int
0 (ByteArray -> Int
PM.sizeofByteArray ByteArray
b)
length :: Bytes -> Int
{-# inline length #-}
length :: Bytes -> Int
length (Bytes ByteArray
_ Int
_ Int
len) = Int
len
fnv1a32 :: Bytes -> Word32
fnv1a32 :: Bytes -> Word32
fnv1a32 !Bytes
b = (Word32 -> Word8 -> Word32) -> Word32 -> Bytes -> Word32
forall a. (a -> Word8 -> a) -> a -> Bytes -> a
foldl'
(\Word32
acc Word8
w -> (Word8 -> Word32
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 Bytes
b
fnv1a64 :: Bytes -> Word64
fnv1a64 :: Bytes -> Word64
fnv1a64 !Bytes
b = (Word64 -> Word8 -> Word64) -> Word64 -> Bytes -> Word64
forall a. (a -> Word8 -> a) -> a -> Bytes -> a
foldl'
(\Word64
acc Word8
w -> (Word8 -> Word64
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 Bytes
b
foldl :: (a -> Word8 -> a) -> a -> Bytes -> a
{-# inline foldl #-}
foldl :: (a -> Word8 -> a) -> a -> Bytes -> a
foldl a -> Word8 -> a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) =
Int -> Int -> a
forall t. (Eq t, Num t) => Int -> t -> a
go (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
go :: Int -> t -> a
go !Int
off !t
ix = case t
ix of
(-1) -> a
a0
t
_ -> a -> Word8 -> a
f (Int -> t -> a
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (t
ix t -> t -> t
forall a. Num a => a -> a -> a
- t
1)) (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)
foldl' :: (a -> Word8 -> a) -> a -> Bytes -> a
{-# inline foldl' #-}
foldl' :: (a -> Word8 -> a) -> a -> Bytes -> a
foldl' a -> Word8 -> a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) = a -> Int -> Int -> a
forall t. (Eq t, Num t) => a -> Int -> t -> a
go a
a0 Int
off0 Int
len0 where
go :: a -> Int -> t -> a
go !a
a !Int
off !t
len = case t
len of
t
0 -> a
a
t
_ -> a -> Int -> t -> a
go (a -> Word8 -> a
f a
a (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
foldlM :: Monad m => (a -> Word8 -> m a) -> a -> Bytes -> m a
{-# inline foldlM #-}
foldlM :: (a -> Word8 -> m a) -> a -> Bytes -> m a
foldlM a -> Word8 -> m a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) = a -> Int -> Int -> m a
forall t. (Eq t, Num t) => a -> Int -> t -> m a
go a
a0 Int
off0 Int
len0 where
go :: a -> Int -> t -> m a
go a
a !Int
off !t
len = case t
len of
t
0 -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
t
_ -> do
a
a' <- a -> Word8 -> m a
f a
a (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)
a -> Int -> t -> m a
go a
a' (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
foldr :: (Word8 -> a -> a) -> a -> Bytes -> a
{-# inline foldr #-}
foldr :: (Word8 -> a -> a) -> a -> Bytes -> a
foldr Word8 -> a -> a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) = Int -> Int -> a
forall t. (Eq t, Num t) => Int -> t -> a
go Int
off0 Int
len0 where
go :: Int -> t -> a
go !Int
off !t
len = case t
len of
t
0 -> a
a0
t
_ -> Word8 -> a -> a
f (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off) (Int -> t -> a
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1))
ifoldl' :: (a -> Int -> Word8 -> a) -> a -> Bytes -> a
{-# inline ifoldl' #-}
ifoldl' :: (a -> Int -> Word8 -> a) -> a -> Bytes -> a
ifoldl' a -> Int -> Word8 -> a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) = a -> Int -> Int -> Int -> a
forall t. (Eq t, Num t) => a -> Int -> Int -> t -> a
go a
a0 Int
0 Int
off0 Int
len0 where
go :: a -> Int -> Int -> t -> a
go !a
a !Int
ix !Int
off !t
len = case t
len of
t
0 -> a
a
t
_ -> a -> Int -> Int -> t -> a
go (a -> Int -> Word8 -> a
f a
a Int
ix (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)) (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
foldr' :: (Word8 -> a -> a) -> a -> Bytes -> a
{-# inline foldr' #-}
foldr' :: (Word8 -> a -> a) -> a -> Bytes -> a
foldr' Word8 -> a -> a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) =
a -> Int -> Int -> a
forall t. (Eq t, Num t) => a -> Int -> t -> a
go a
a0 (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
go :: a -> Int -> t -> a
go !a
a !Int
off !t
ix = case t
ix of
(-1) -> a
a
t
_ -> a -> Int -> t -> a
go (Word8 -> a -> a
f (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off) a
a) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (t
ix t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
foldrM :: Monad m => (Word8 -> a -> m a) -> a -> Bytes -> m a
{-# inline foldrM #-}
foldrM :: (Word8 -> a -> m a) -> a -> Bytes -> m a
foldrM Word8 -> a -> m a
f a
a0 (Bytes ByteArray
arr Int
off0 Int
len0) =
a -> Int -> Int -> m a
forall t. (Eq t, Num t) => a -> Int -> t -> m a
go a
a0 (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
len0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
go :: a -> Int -> t -> m a
go !a
a !Int
off !t
ix = case t
ix of
(-1) -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
t
_ -> do
a
a' <- Word8 -> a -> m a
f (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off) a
a
a -> Int -> t -> m a
go a
a' (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (t
ix t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
contents :: Bytes -> Ptr Word8
{-# inline contents #-}
contents :: Bytes -> Ptr Word8
contents (Bytes ByteArray
arr Int
off Int
_) = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr (ByteArray -> Ptr Word8
PM.byteArrayContents ByteArray
arr) Int
off
toPinnedByteArray :: Bytes -> ByteArray
{-# inline toPinnedByteArray #-}
toPinnedByteArray :: Bytes -> ByteArray
toPinnedByteArray b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len)
| Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0, ByteArray -> Int
PM.sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len, ByteArray -> Bool
PM.isByteArrayPinned ByteArray
arr = ByteArray
arr
| Bool
otherwise = Bytes -> ByteArray
toPinnedByteArrayClone Bytes
b
toPinnedByteArrayClone :: Bytes -> ByteArray
toPinnedByteArrayClone :: Bytes -> ByteArray
toPinnedByteArrayClone (Bytes ByteArray
arr Int
off Int
len) = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
MutableByteArray s
m <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray 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))
m Int
0 ByteArray
arr Int
off Int
len
MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
m
toByteString :: Bytes -> ByteString
toByteString :: Bytes -> ByteString
toByteString !Bytes
b = Bytes -> ByteString
pinnedToByteString (Bytes -> Bytes
pin Bytes
b)
pinnedToByteString :: Bytes -> ByteString
pinnedToByteString :: Bytes -> ByteString
pinnedToByteString (Bytes y :: ByteArray
y@(PM.ByteArray ByteArray#
x) Int
off Int
len) =
ForeignPtr Word8 -> Int -> Int -> ByteString
ByteString.PS
(Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr.ForeignPtr
(case Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr (ByteArray -> Ptr Word8
PM.byteArrayContents ByteArray
y) Int
off of {Exts.Ptr Addr#
p -> Addr#
p})
(MutableByteArray# RealWorld -> ForeignPtrContents
ForeignPtr.PlainPtr (ByteArray# -> MutableByteArray# RealWorld
Exts.unsafeCoerce# ByteArray#
x))
)
Int
0 Int
len
fromByteString :: ByteString -> Bytes
fromByteString :: ByteString -> Bytes
fromByteString !ByteString
b = ByteArray -> Int -> Int -> Bytes
Bytes
( (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ IO ByteArray -> ST s ByteArray
forall a s. IO a -> ST s a
unsafeIOToST (IO ByteArray -> ST s ByteArray) -> IO ByteArray -> ST s ByteArray
forall a b. (a -> b) -> a -> b
$ do
dst :: MutableByteArray RealWorld
dst@(PM.MutableByteArray MutableByteArray# RealWorld
dst# ) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
len
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.unsafeUseAsCString ByteString
b ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
src -> do
MutablePrimArray (PrimState IO) CChar
-> Int -> CString -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
PM.copyPtrToMutablePrimArray (MutableByteArray# RealWorld -> MutablePrimArray RealWorld CChar
forall s a. MutableByteArray# s -> MutablePrimArray s a
PM.MutablePrimArray MutableByteArray# RealWorld
dst# ) Int
0 CString
src Int
len
MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
dst
) Int
0 Int
len
where
!len :: Int
len = ByteString -> Int
ByteString.length ByteString
b