{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Data.ByteArray.Bytes
( Bytes
) where
#if MIN_VERSION_base(4,15,0)
import GHC.Exts (unsafeCoerce#)
#endif
import GHC.Word
import GHC.Char (chr)
import GHC.Types
import GHC.Prim
import GHC.Ptr
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup
import Data.Foldable (toList)
#else
import Data.Monoid
#endif
import Data.Memory.PtrMethods
import Data.Memory.Internal.Imports
import Data.Memory.Internal.CompatPrim
import Data.Memory.Internal.Compat (unsafeDoIO)
import Data.ByteArray.Types
import Data.Typeable
#ifdef MIN_VERSION_basement
import Basement.NormalForm
#endif
import Basement.IntegralConv
data Bytes = Bytes (MutableByteArray# RealWorld)
deriving (Typeable)
instance Show Bytes where
showsPrec :: Int -> Bytes -> ShowS
showsPrec Int
p Bytes
b String
r = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Bytes -> ShowS
bytesUnpackChars Bytes
b []) String
r
instance Eq Bytes where
== :: Bytes -> Bytes -> Bool
(==) = Bytes -> Bytes -> Bool
bytesEq
instance Ord Bytes where
compare :: Bytes -> Bytes -> Ordering
compare = Bytes -> Bytes -> Ordering
bytesCompare
#if MIN_VERSION_base(4,9,0)
instance Semigroup Bytes where
Bytes
b1 <> :: Bytes -> Bytes -> Bytes
<> Bytes
b2 = IO Bytes -> Bytes
forall a. IO a -> a
unsafeDoIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> IO Bytes
bytesAppend Bytes
b1 Bytes
b2
sconcat :: NonEmpty Bytes -> Bytes
sconcat = IO Bytes -> Bytes
forall a. IO a -> a
unsafeDoIO (IO Bytes -> Bytes)
-> (NonEmpty Bytes -> IO Bytes) -> NonEmpty Bytes -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bytes] -> IO Bytes
bytesConcat ([Bytes] -> IO Bytes)
-> (NonEmpty Bytes -> [Bytes]) -> NonEmpty Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Bytes -> [Bytes]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif
instance Monoid Bytes where
mempty :: Bytes
mempty = IO Bytes -> Bytes
forall a. IO a -> a
unsafeDoIO (Int -> IO Bytes
newBytes Int
0)
#if !(MIN_VERSION_base(4,11,0))
mappend b1 b2 = unsafeDoIO $ bytesAppend b1 b2
mconcat = unsafeDoIO . bytesConcat
#endif
instance NFData Bytes where
rnf :: Bytes -> ()
rnf Bytes
b = Bytes
b Bytes -> () -> ()
`seq` ()
#ifdef MIN_VERSION_basement
instance NormalForm Bytes where
toNormalForm :: Bytes -> ()
toNormalForm Bytes
b = Bytes
b Bytes -> () -> ()
`seq` ()
#endif
instance ByteArrayAccess Bytes where
length :: Bytes -> Int
length = Bytes -> Int
bytesLength
withByteArray :: Bytes -> (Ptr p -> IO a) -> IO a
withByteArray = Bytes -> (Ptr p -> IO a) -> IO a
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withBytes
instance ByteArray Bytes where
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
allocRet = Int -> (Ptr p -> IO a) -> IO (a, Bytes)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
bytesAllocRet
newBytes :: Int -> IO Bytes
newBytes :: Int -> IO Bytes
newBytes (I# Int#
sz)
| Int# -> Bool
booleanPrim (Int#
sz Int# -> Int# -> Int#
<# Int#
0#) = String -> IO Bytes
forall a. HasCallStack => String -> a
error String
"Bytes: size must be >= 0"
| Bool
otherwise = (State# RealWorld -> (# State# RealWorld, Bytes #)) -> IO Bytes
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bytes #)) -> IO Bytes)
-> (State# RealWorld -> (# State# RealWorld, Bytes #)) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
sz Int#
8# State# RealWorld
s of
(# State# RealWorld
s', MutableByteArray# RealWorld
mbarr #) -> (# State# RealWorld
s', MutableByteArray# RealWorld -> Bytes
Bytes MutableByteArray# RealWorld
mbarr #)
touchBytes :: Bytes -> IO ()
touchBytes :: Bytes -> IO ()
touchBytes (Bytes MutableByteArray# RealWorld
mba) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
mba State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #)
{-# INLINE touchBytes #-}
sizeofBytes :: Bytes -> Int
sizeofBytes :: Bytes -> Int
sizeofBytes (Bytes MutableByteArray# RealWorld
mba) = Int# -> Int
I# (MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
mba)
{-# INLINE sizeofBytes #-}
withPtr :: Bytes -> (Ptr p -> IO a) -> IO a
withPtr :: Bytes -> (Ptr p -> IO a) -> IO a
withPtr b :: Bytes
b@(Bytes MutableByteArray# RealWorld
mba) Ptr p -> IO a
f = do
a
a <- Ptr p -> IO a
f (Addr# -> Ptr p
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
unsafeCoerce# MutableByteArray# RealWorld
mba)))
Bytes -> IO ()
touchBytes Bytes
b
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
bytesAlloc :: Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc :: Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
sz Ptr p -> IO ()
f = do
Bytes
ba <- Int -> IO Bytes
newBytes Int
sz
Bytes -> (Ptr p -> IO ()) -> IO ()
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
ba Ptr p -> IO ()
f
Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
ba
bytesConcat :: [Bytes] -> IO Bytes
bytesConcat :: [Bytes] -> IO Bytes
bytesConcat [Bytes]
l = Int -> (Ptr Word8 -> IO ()) -> IO Bytes
forall p. Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
retLen ([Bytes] -> Ptr Word8 -> IO ()
copy [Bytes]
l)
where
!retLen :: Int
retLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Bytes -> Int) -> [Bytes] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Bytes -> Int
bytesLength [Bytes]
l
copy :: [Bytes] -> Ptr Word8 -> IO ()
copy [] Ptr Word8
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
copy (Bytes
x:[Bytes]
xs) Ptr Word8
dst = do
Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy Ptr Word8
dst Ptr Word8
src Int
chunkLen
[Bytes] -> Ptr Word8 -> IO ()
copy [Bytes]
xs (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
chunkLen)
where
!chunkLen :: Int
chunkLen = Bytes -> Int
bytesLength Bytes
x
bytesAppend :: Bytes -> Bytes -> IO Bytes
bytesAppend :: Bytes -> Bytes -> IO Bytes
bytesAppend Bytes
b1 Bytes
b2 = Int -> (Ptr Word8 -> IO ()) -> IO Bytes
forall p. Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
retLen ((Ptr Word8 -> IO ()) -> IO Bytes)
-> (Ptr Word8 -> IO ()) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
b1 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s1 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy Ptr Word8
dst Ptr Word8
s1 Int
len1
Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
b2 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s2 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1) Ptr Word8
s2 Int
len2
where
!len1 :: Int
len1 = Bytes -> Int
bytesLength Bytes
b1
!len2 :: Int
len2 = Bytes -> Int
bytesLength Bytes
b2
!retLen :: Int
retLen = Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2
bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
bytesAllocRet Int
sz Ptr p -> IO a
f = do
Bytes
ba <- Int -> IO Bytes
newBytes Int
sz
a
r <- Bytes -> (Ptr p -> IO a) -> IO a
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
ba Ptr p -> IO a
f
(a, Bytes) -> IO (a, Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, Bytes
ba)
bytesLength :: Bytes -> Int
bytesLength :: Bytes -> Int
bytesLength = Bytes -> Int
sizeofBytes
{-# LANGUAGE bytesLength #-}
withBytes :: Bytes -> (Ptr p -> IO a) -> IO a
withBytes :: Bytes -> (Ptr p -> IO a) -> IO a
withBytes = Bytes -> (Ptr p -> IO a) -> IO a
forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr
bytesEq :: Bytes -> Bytes -> Bool
bytesEq :: Bytes -> Bytes -> Bool
bytesEq b1 :: Bytes
b1@(Bytes MutableByteArray# RealWorld
m1) b2 :: Bytes
b2@(Bytes MutableByteArray# RealWorld
m2)
| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l2 = Bool
False
| Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
unsafeDoIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> Int# -> State# RealWorld -> (# State# RealWorld, Bool #)
loop Int#
0# State# RealWorld
s
where
!l1 :: Int
l1@(I# Int#
len) = Bytes -> Int
bytesLength Bytes
b1
!l2 :: Int
l2 = Bytes -> Int
bytesLength Bytes
b2
loop :: Int# -> State# RealWorld -> (# State# RealWorld, Bool #)
loop Int#
i State# RealWorld
s
| Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
len) = (# State# RealWorld
s, Bool
True #)
| Bool
otherwise =
case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# RealWorld
m1 Int#
i State# RealWorld
s of
(# State# RealWorld
s', Word#
e1 #) -> case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# RealWorld
m2 Int#
i State# RealWorld
s' of
(# State# RealWorld
s'', Word#
e2 #) ->
if (Word# -> Word8
W8# Word#
e1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word# -> Word8
W8# Word#
e2)
then Int# -> State# RealWorld -> (# State# RealWorld, Bool #)
loop (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s''
else (# State# RealWorld
s'', Bool
False #)
{-# INLINE loop #-}
bytesCompare :: Bytes -> Bytes -> Ordering
bytesCompare :: Bytes -> Bytes -> Ordering
bytesCompare b1 :: Bytes
b1@(Bytes MutableByteArray# RealWorld
m1) b2 :: Bytes
b2@(Bytes MutableByteArray# RealWorld
m2) = IO Ordering -> Ordering
forall a. IO a -> a
unsafeDoIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ Int -> IO Ordering
loop Int
0
where
!l1 :: Int
l1 = Bytes -> Int
bytesLength Bytes
b1
!l2 :: Int
l2 = Bytes -> Int
bytesLength Bytes
b2
!len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l1 Int
l2
loop :: Int -> IO Ordering
loop !Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len =
if Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2
then Ordering -> IO Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
else if Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l2 then Ordering -> IO Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
else Ordering -> IO Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
| Bool
otherwise = do
Word8
e1 <- MutableByteArray# RealWorld -> Int -> IO Word8
read8 MutableByteArray# RealWorld
m1 Int
i
Word8
e2 <- MutableByteArray# RealWorld -> Int -> IO Word8
read8 MutableByteArray# RealWorld
m2 Int
i
if Word8
e1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
e2
then Int -> IO Ordering
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else if Word8
e1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
e2 then Ordering -> IO Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
else Ordering -> IO Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
read8 :: MutableByteArray# RealWorld -> Int -> IO Word8
read8 MutableByteArray# RealWorld
m (I# Int#
i) = (State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8)
-> (State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# RealWorld
m Int#
i State# RealWorld
s of
(# State# RealWorld
s2, Word#
e #) -> (# State# RealWorld
s2, Word# -> Word8
W8# Word#
e #)
bytesUnpackChars :: Bytes -> String -> String
bytesUnpackChars :: Bytes -> ShowS
bytesUnpackChars (Bytes MutableByteArray# RealWorld
mba) String
xs = Int# -> String
chunkLoop Int#
0#
where
!len :: Int#
len = MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
mba
chunkLoop :: Int# -> [Char]
chunkLoop :: Int# -> String
chunkLoop Int#
idx
| Int# -> Bool
booleanPrim (Int#
len Int# -> Int# -> Int#
==# Int#
idx) = []
| Int# -> Bool
booleanPrim ((Int#
len Int# -> Int# -> Int#
-# Int#
idx) Int# -> Int# -> Int#
># Int#
63#) =
Int# -> Int# -> ShowS
bytesLoop Int#
idx Int#
64# (Int# -> String
chunkLoop (Int#
idx Int# -> Int# -> Int#
+# Int#
64#))
| Bool
otherwise =
Int# -> Int# -> ShowS
bytesLoop Int#
idx (Int#
len Int# -> Int# -> Int#
-# Int#
idx) String
xs
bytesLoop :: Int# -> Int# -> ShowS
bytesLoop Int#
idx Int#
chunkLenM1 String
paramAcc = IO String -> String
forall a. IO a -> a
unsafeDoIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$
Int# -> String -> IO String
loop (Int#
idx Int# -> Int# -> Int#
+# Int#
chunkLenM1 Int# -> Int# -> Int#
-# Int#
1#) String
paramAcc
where loop :: Int# -> String -> IO String
loop Int#
i String
acc
| Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
idx) = do
Char
c <- Int# -> IO Char
rChar Int#
i
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
| Bool
otherwise = do
Char
c <- Int# -> IO Char
rChar Int#
i
Int# -> String -> IO String
loop (Int#
i Int# -> Int# -> Int#
-# Int#
1#) (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
rChar :: Int# -> IO Char
rChar :: Int# -> IO Char
rChar Int#
idx = (State# RealWorld -> (# State# RealWorld, Char #)) -> IO Char
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Char #)) -> IO Char)
-> (State# RealWorld -> (# State# RealWorld, Char #)) -> IO Char
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# RealWorld
mba Int#
idx State# RealWorld
s of
(# State# RealWorld
s2, Word#
w #) -> (# State# RealWorld
s2, Int -> Char
chr (Word8 -> Int
forall a b. IntegralUpsize a b => a -> b
integralUpsize (Word# -> Word8
W8# Word#
w)) #)