-- |
-- Module      : Data.ByteArray.Bytes
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : Good
--
-- Simple and efficient byte array types
--
{-# 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

-- | Simplest Byte Array
data Bytes = Bytes (MutableByteArray# RealWorld)
  deriving (Typeable)

instance Show Bytes where
    showsPrec :: Int -> Bytes -> ShowS
showsPrec Int
p Bytes
b String
r = 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      = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> IO Bytes
bytesAppend Bytes
b1 Bytes
b2
    sconcat :: NonEmpty Bytes -> Bytes
sconcat       = forall a. IO a -> a
unsafeDoIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bytes] -> IO Bytes
bytesConcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif
instance Monoid Bytes where
    mempty :: Bytes
mempty        = 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 seq :: forall a b. a -> b -> b
`seq` ()
#ifdef MIN_VERSION_basement
instance NormalForm Bytes where
    toNormalForm :: Bytes -> ()
toNormalForm Bytes
b = Bytes
b seq :: forall a b. a -> b -> b
`seq` ()
#endif
instance ByteArrayAccess Bytes where
    length :: Bytes -> Int
length        = Bytes -> Int
bytesLength
    withByteArray :: forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withByteArray = forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withBytes
instance ByteArray Bytes where
    allocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, Bytes)
allocRet = 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#) = forall a. HasCallStack => String -> a
error String
"Bytes: size must be >= 0"
    | Bool
otherwise              = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
        case 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) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case touch# :: 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# (forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
mba)
{-# INLINE sizeofBytes #-}

withPtr :: Bytes -> (Ptr p -> IO a) -> IO a
withPtr :: forall p a. 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 (forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
mba)))
    Bytes -> IO ()
touchBytes Bytes
b
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a
------------------------------------------------------------------------

bytesAlloc :: Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc :: forall p. Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
sz Ptr p -> IO ()
f = do
    Bytes
ba <- Int -> IO Bytes
newBytes Int
sz
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
ba Ptr p -> IO ()
f
    forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
ba

bytesConcat :: [Bytes] -> IO Bytes
bytesConcat :: [Bytes] -> IO Bytes
bytesConcat [Bytes]
l = forall p. Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
retLen ([Bytes] -> Ptr Word8 -> IO ()
copy [Bytes]
l)
  where
    !retLen :: Int
retLen = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Bytes -> Int
bytesLength [Bytes]
l

    copy :: [Bytes] -> Ptr Word8 -> IO ()
copy []     Ptr Word8
_   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    copy (Bytes
x:[Bytes]
xs) Ptr Word8
dst = do
        forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
x 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 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 = forall p. Int -> (Ptr p -> IO ()) -> IO Bytes
bytesAlloc Int
retLen forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
b1 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
    forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
b2 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s2 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy (Ptr Word8
dst 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 forall a. Num a => a -> a -> a
+ Int
len2

bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes)
bytesAllocRet :: forall p a. 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 <- forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withPtr Bytes
ba Ptr p -> IO a
f
    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 :: forall p a. Bytes -> (Ptr p -> IO a) -> IO a
withBytes = 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 forall a. Eq a => a -> a -> Bool
/= Int
l2  = Bool
False
    | Bool
otherwise = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO 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 forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word8# #)
readWord8Array# MutableByteArray# RealWorld
m1 Int#
i State# RealWorld
s of
                (# State# RealWorld
s', Word8#
e1 #) -> case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word8# #)
readWord8Array# MutableByteArray# RealWorld
m2 Int#
i State# RealWorld
s' of
                    (# State# RealWorld
s'', Word8#
e2 #) ->
                        if (Word8# -> Word8
W8# Word8#
e1) forall a. Eq a => a -> a -> Bool
== (Word8# -> Word8
W8# Word8#
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) = forall a. IO a -> a
unsafeDoIO 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 = forall a. Ord a => a -> a -> a
min Int
l1 Int
l2

    loop :: Int -> IO Ordering
loop !Int
i
        | Int
i forall a. Eq a => a -> a -> Bool
== Int
len =
            if Int
l1 forall a. Eq a => a -> a -> Bool
== Int
l2
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
                else if Int
l1 forall a. Ord a => a -> a -> Bool
> Int
l2 then forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
                                else 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 forall a. Eq a => a -> a -> Bool
== Word8
e2
                then Int -> IO Ordering
loop (Int
iforall a. Num a => a -> a -> a
+Int
1)
                else if Word8
e1 forall a. Ord a => a -> a -> Bool
< Word8
e2 then forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
                                else forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT

    read8 :: MutableByteArray# RealWorld -> Int -> IO Word8
read8 MutableByteArray# RealWorld
m (I# Int#
i) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word8# #)
readWord8Array# MutableByteArray# RealWorld
m Int#
i State# RealWorld
s of
                                    (# State# RealWorld
s2, Word8#
e #) -> (# State# RealWorld
s2, Word8# -> Word8
W8# Word8#
e #)

bytesUnpackChars :: Bytes -> String -> String
bytesUnpackChars :: Bytes -> ShowS
bytesUnpackChars (Bytes MutableByteArray# RealWorld
mba) String
xs = Int# -> String
chunkLoop Int#
0#
  where
    !len :: Int#
len = forall d. MutableByteArray# d -> Int#
sizeofMutableByteArray# MutableByteArray# RealWorld
mba
    -- chunk 64 bytes at a time
    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 = forall a. IO a -> a
unsafeDoIO 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
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c 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 forall a. a -> [a] -> [a]
: String
acc)

    rChar :: Int# -> IO Char
    rChar :: Int# -> IO Char
rChar Int#
idx = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
        case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word8# #)
readWord8Array# MutableByteArray# RealWorld
mba Int#
idx State# RealWorld
s of
            (# State# RealWorld
s2, Word8#
w #) -> (# State# RealWorld
s2, Int -> Char
chr (forall a b. IntegralUpsize a b => a -> b
integralUpsize (Word8# -> Word8
W8# Word8#
w)) #)

{-
bytesShowHex :: Bytes -> String
bytesShowHex b = showHexadecimal (withPtr b) (bytesLength b)
{-# NOINLINE bytesShowHex #-}
-}