-- |
-- Module      : Data.Array.Byte
-- Copyright   : (c) Roman Leshchinskiy 2009-2012
-- License     : BSD-style
--
-- Maintainer  : libraries@haskell.org
-- Portability : non-portable
--
-- Derived from @primitive@ package.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Data.Array.Byte (
  ByteArray(..),
  MutableByteArray(..),
) where

import GHC.Internal.Data.Bits ((.&.), unsafeShiftR)
import GHC.Internal.Data.Data (mkNoRepType, Data(..))
import GHC.Internal.Data.Typeable (Typeable)
import qualified GHC.Internal.Data.Foldable as F
import GHC.Internal.Data.Maybe (fromMaybe)
import Data.Semigroup
import GHC.Internal.Exts
import GHC.Num.Integer (Integer(..))
import GHC.Internal.Show (intToDigit)
import GHC.Internal.ST (ST(..), runST)
import GHC.Internal.Word (Word8(..))
import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Monad
import GHC.Internal.TH.Lift
import GHC.Internal.ForeignPtr
import Prelude

-- | Lifted wrapper for 'ByteArray#'.
--
-- Since 'ByteArray#' is an unlifted type and not a member of kind 'Data.Kind.Type',
-- things like @[ByteArray#]@ or @IO ByteArray#@ are ill-typed. To work around this
-- inconvenience this module provides a standard lifted wrapper, inhabiting 'Data.Kind.Type'.
-- Clients are expected to use 'ByteArray' in higher-level APIs,
-- but wrap and unwrap 'ByteArray' internally as they please
-- and use functions from "GHC.Exts".
--
-- The memory representation of a 'ByteArray' is:
--
-- > ╭─────────────┬───╮  ╭────────┬──────┬─────────╮
-- > │ Constructor │ * ┼─►│ Header │ Size │ Payload │
-- > ╰─────────────┴───╯  ╰────────┴──────┴─────────╯
--
-- And its overhead is the following:
--
-- * 'ByteArray' constructor: 1 word
-- * Pointer to 'ByteArray#': 1 word
-- * 'ByteArray#' Header: 1 word
-- * 'ByteArray#' Size: 1 word
--
-- Where a word is the unit of heap allocation,
-- measuring 8 bytes on 64-bit systems, and 4 bytes on 32-bit systems.
--
-- @since 4.17.0.0
data ByteArray = ByteArray ByteArray#

-- | Lifted wrapper for 'MutableByteArray#'.
--
-- Since 'MutableByteArray#' is an unlifted type and not a member of kind 'Data.Kind.Type',
-- things like @[MutableByteArray#]@ or @IO MutableByteArray#@ are ill-typed. To work around this
-- inconvenience this module provides a standard lifted wrapper, inhabiting 'Data.Kind.Type'.
-- Clients are expected to use 'MutableByteArray' in higher-level APIs,
-- but wrap and unwrap 'MutableByteArray' internally as they please
-- and use functions from "GHC.Exts".
--
-- @since 4.17.0.0
data MutableByteArray s = MutableByteArray (MutableByteArray# s)

-- | Create a new mutable byte array of the specified size in bytes.
--
-- /Note:/ this function does not check if the input is non-negative.
newByteArray :: Int -> ST s (MutableByteArray s)
{-# INLINE newByteArray #-}
newByteArray :: forall s. Int -> ST s (MutableByteArray s)
newByteArray (I# Int#
n#) =
  STRep s (MutableByteArray s) -> ST s (MutableByteArray s)
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
n# State# s
s# of
    (# State# s
s'#, MutableByteArray# s
arr# #) -> (# State# s
s'#, MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
arr# #))

-- | Convert a mutable byte array to an immutable one without copying. The
-- array should not be modified after the conversion.
unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray
{-# INLINE unsafeFreezeByteArray #-}
unsafeFreezeByteArray :: forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray (MutableByteArray MutableByteArray# s
arr#) =
  STRep s ByteArray -> ST s ByteArray
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
arr# State# s
s# of
    (# State# s
s'#, ByteArray#
arr'# #) -> (# State# s
s'#, ByteArray# -> ByteArray
ByteArray ByteArray#
arr'# #))

-- | Size of the byte array in bytes.
sizeofByteArray :: ByteArray -> Int
{-# INLINE sizeofByteArray #-}
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (ByteArray ByteArray#
arr#) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr#)

-- | Read byte at specific index.
indexByteArray :: ByteArray -> Int -> Word8
{-# INLINE indexByteArray #-}
indexByteArray :: ByteArray -> Int -> Word8
indexByteArray (ByteArray ByteArray#
arr#) (I# Int#
i#) = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
arr# Int#
i#)

-- | Write byte at specific index.
writeByteArray :: MutableByteArray s -> Int -> Word8 -> ST s ()
{-# INLINE writeByteArray #-}
writeByteArray :: forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeByteArray (MutableByteArray MutableByteArray# s
arr#) (I# Int#
i#) (W8# Word8#
x#) =
  STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
arr# Int#
i# Word8#
x# State# s
s# of
    State# s
s'# -> (# State# s
s'#, () #))

-- | Explode 'ByteArray' into a list of bytes.
byteArrayToList :: ByteArray -> [Word8]
{-# INLINE byteArrayToList #-}
byteArrayToList :: ByteArray -> [Word8]
byteArrayToList ByteArray
arr = Int -> [Word8]
go Int
0
  where
    go :: Int -> [Word8]
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxI  = ByteArray -> Int -> Word8
indexByteArray ByteArray
arr Int
i Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> [Word8]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
      | Bool
otherwise = []
    maxI :: Int
maxI = ByteArray -> Int
sizeofByteArray ByteArray
arr

-- | Create a 'ByteArray' from a list of a known length. If the length
--   of the list does not match the given length, this throws an exception.
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN :: Int -> [Word8] -> ByteArray
byteArrayFromListN Int
n [Word8]
ys
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    marr <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
n
    let go !Int
ix [] = if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
          then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else [Char] -> ST s ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> ST s ()) -> [Char] -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Array.Byte.byteArrayFromListN: list length less than specified size"
        go !Int
ix (Word8
x : [Word8]
xs) = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
          then do
            MutableByteArray s -> Int -> Word8 -> ST s ()
forall s. MutableByteArray s -> Int -> Word8 -> ST s ()
writeByteArray MutableByteArray s
marr Int
ix Word8
x
            Int -> [Word8] -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word8]
xs
          else [Char] -> ST s ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> ST s ()) -> [Char] -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Array.Byte.byteArrayFromListN: list length greater than specified size"
    go 0 ys
    unsafeFreezeByteArray marr
  | Bool
otherwise = [Char] -> ByteArray
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Array.Byte.ByteArrayFromListN: specified size is negative"

-- | Copy a slice of an immutable byte array to a mutable byte array.
--
-- /Note:/ this function does not do bounds or overlap checking.
unsafeCopyByteArray
  :: MutableByteArray s -- ^ destination array
  -> Int                -- ^ offset into destination array
  -> ByteArray          -- ^ source array
  -> Int                -- ^ offset into source array
  -> Int                -- ^ number of bytes to copy
  -> ST s ()
{-# INLINE unsafeCopyByteArray #-}
unsafeCopyByteArray :: forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
unsafeCopyByteArray (MutableByteArray MutableByteArray# s
dst#) (I# Int#
doff#) (ByteArray ByteArray#
src#) (I# Int#
soff#) (I# Int#
sz#) =
  STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# Int#
soff# MutableByteArray# s
dst# Int#
doff# Int#
sz# State# s
s# of
    State# s
s'# -> (# State# s
s'#, () #))

-- | Copy a slice from one mutable byte array to another
-- or to the same mutable byte array.
--
-- /Note:/ this function does not do bounds or overlap checking.
unsafeCopyMutableByteArray
  :: MutableByteArray s -- ^ destination array
  -> Int                -- ^ offset into destination array
  -> MutableByteArray s -- ^ source array
  -> Int                -- ^ offset into source array
  -> Int                -- ^ number of bytes to copy
  -> ST s ()
{-# INLINE unsafeCopyMutableByteArray #-}
unsafeCopyMutableByteArray :: forall s.
MutableByteArray s
-> Int -> MutableByteArray s -> Int -> Int -> ST s ()
unsafeCopyMutableByteArray (MutableByteArray MutableByteArray# s
dst#) (I# Int#
doff#) (MutableByteArray MutableByteArray# s
src#) (I# Int#
soff#) (I# Int#
sz#) =
  STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (\State# s
s# -> case MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArrayNonOverlapping# MutableByteArray# s
src# Int#
soff# MutableByteArray# s
dst# Int#
doff# Int#
sz# State# s
s# of
    State# s
s'# -> (# State# s
s'#, () #))

-- | @since 4.17.0.0
instance Data ByteArray where
  toConstr :: ByteArray -> Constr
toConstr ByteArray
_ = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteArray
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = [Char] -> Constr -> c ByteArray
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: ByteArray -> DataType
dataTypeOf ByteArray
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.Array.Byte.ByteArray"

-- | @since 4.17.0.0
instance Typeable s => Data (MutableByteArray s) where
  toConstr :: MutableByteArray s -> Constr
toConstr MutableByteArray s
_ = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableByteArray s)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = [Char] -> Constr -> c (MutableByteArray s)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: MutableByteArray s -> DataType
dataTypeOf MutableByteArray s
_ = [Char] -> DataType
mkNoRepType [Char]
"Data.Array.Byte.MutableByteArray"

-- | @since 4.17.0.0
instance Show ByteArray where
  showsPrec :: Int -> ByteArray -> ShowS
showsPrec Int
_ ByteArray
ba =
      [Char] -> ShowS
showString [Char]
"[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go Int
0
    where
      showW8 :: Word8 -> String -> String
      showW8 :: Word8 -> ShowS
showW8 !Word8
w [Char]
s =
          Char
'0'
        Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'x'
        Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
w Int
4))
        Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F))
        Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
s
      go :: Int -> ShowS
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteArray -> Int
sizeofByteArray ByteArray
ba = ShowS
comma ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
showW8 (ByteArray -> Int -> Word8
indexByteArray ByteArray
ba Int
i :: Word8) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise              = Char -> ShowS
showChar Char
']'
        where
          comma :: ShowS
comma | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = ShowS
forall a. a -> a
id
                | Bool
otherwise = [Char] -> ShowS
showString [Char]
", "

instance Lift ByteArray where
  liftTyped :: forall (m :: * -> *). Quote m => ByteArray -> Code m ByteArray
liftTyped = m Exp -> Code m ByteArray
forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce (m Exp -> Code m ByteArray)
-> (ByteArray -> m Exp) -> ByteArray -> Code m ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => ByteArray -> m Exp
lift
  lift :: forall (m :: * -> *). Quote m => ByteArray -> m Exp
lift (ByteArray ByteArray#
b) =
    [| addrToByteArray $(Int -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
len)
                       $(Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> m Exp) -> (Bytes -> Exp) -> Bytes -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (Bytes -> Lit) -> Bytes -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Lit
BytesPrimL (Bytes -> m Exp) -> Bytes -> m Exp
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Word -> Word -> Bytes
Bytes ForeignPtr Word8
ptr Word
0 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
    |]
    where
      len# :: Int#
len# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
b
      len :: Int
len = Int# -> Int
I# Int#
len#
      pb :: ByteArray#
      !(ByteArray ByteArray#
pb)
        | Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
b) = ByteArray# -> ByteArray
ByteArray ByteArray#
b
        | Bool
otherwise = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ STRep s ByteArray -> ST s ByteArray
forall s a. STRep s a -> ST s a
ST (STRep s ByteArray -> ST s ByteArray)
-> STRep s ByteArray -> ST s ByteArray
forall a b. (a -> b) -> a -> b
$
          \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
len# State# s
s of
            (# State# s
s', MutableByteArray# s
mb #) -> case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
b Int#
0# MutableByteArray# s
mb Int#
0# Int#
len# State# s
s' of
              State# s
s'' -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mb State# s
s'' of
                (# State# s
s''', ByteArray#
ret #) -> (# State# s
s''', ByteArray# -> ByteArray
ByteArray ByteArray#
ret #)
      ptr :: ForeignPtr Word8
      ptr :: ForeignPtr Word8
ptr = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
pb) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
forall a b. a -> b
unsafeCoerce# ByteArray#
pb))

{-# NOINLINE addrToByteArray #-}
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray (I# Int#
len) Addr#
addr = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ STRep s ByteArray -> ST s ByteArray
forall s a. STRep s a -> ST s a
ST (STRep s ByteArray -> ST s ByteArray)
-> STRep s ByteArray -> ST s ByteArray
forall a b. (a -> b) -> a -> b
$
  \State# s
s -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len State# s
s of
    (# State# s
s', MutableByteArray# s
mb #) -> case Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# s
mb Int#
0# Int#
len State# s
s' of
      State# s
s'' -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mb State# s
s'' of
        (# State# s
s''', ByteArray#
ret #) -> (# State# s
s''', ByteArray# -> ByteArray
ByteArray ByteArray#
ret #)

-- | Compare prefixes of given length.
compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering
{-# INLINE compareByteArraysFromBeginning #-}
compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning (ByteArray ByteArray#
ba1#) (ByteArray ByteArray#
ba2#) (I# Int#
n#)
  = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
ba1# Int#
0# ByteArray#
ba2# Int#
0# Int#
n#)) Int
0

-- | Do two byte arrays share the same pointer?
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray :: ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1 ByteArray#
ba2 =
    case ByteArray# -> ByteArray# -> Int#
sameByteArray# ByteArray#
ba1 ByteArray#
ba2 of Int#
r -> Int# -> Bool
isTrue# Int#
r

-- | @since 4.17.0.0
instance Eq ByteArray where
  ba1 :: ByteArray
ba1@(ByteArray ByteArray#
ba1#) == :: ByteArray -> ByteArray -> Bool
== ba2 :: ByteArray
ba2@(ByteArray ByteArray#
ba2#)
    | ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Bool
True
    | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n2 = Bool
False
    | Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning ByteArray
ba1 ByteArray
ba2 Int
n1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    where
      n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
      n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2

-- | @since 4.17.0.0
instance Eq (MutableByteArray s) where
  == :: MutableByteArray s -> MutableByteArray s -> Bool
(==) (MutableByteArray MutableByteArray# s
arr#) (MutableByteArray MutableByteArray# s
brr#)
    = Int# -> Bool
isTrue# (MutableByteArray# s -> MutableByteArray# s -> Int#
forall s. MutableByteArray# s -> MutableByteArray# s -> Int#
sameMutableByteArray# MutableByteArray# s
arr# MutableByteArray# s
brr#)

-- | Non-lexicographic ordering. This compares the lengths of
-- the byte arrays first and uses a lexicographic ordering if
-- the lengths are equal. Subject to change between major versions.
--
-- @since 4.17.0.0
instance Ord ByteArray where
  ba1 :: ByteArray
ba1@(ByteArray ByteArray#
ba1#) compare :: ByteArray -> ByteArray -> Ordering
`compare` ba2 :: ByteArray
ba2@(ByteArray ByteArray#
ba2#)
    | ByteArray# -> ByteArray# -> Bool
sameByteArray ByteArray#
ba1# ByteArray#
ba2# = Ordering
EQ
    | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n2 = Int
n1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
n2
    | Bool
otherwise = ByteArray -> ByteArray -> Int -> Ordering
compareByteArraysFromBeginning ByteArray
ba1 ByteArray
ba2 Int
n1
    where
      n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
      n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2
-- The primop compareByteArrays# (invoked from 'compareByteArraysFromBeginning')
-- performs a check for pointer equality as well. However, it
-- is included here because it is likely better to check for pointer equality
-- before checking for length equality. Getting the length requires deferencing
-- the pointers, which could cause accesses to memory that is not in the cache.
-- By contrast, a pointer equality check is always extremely cheap.

-- | Append two byte arrays.
appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray :: ByteArray -> ByteArray -> ByteArray
appendByteArray ByteArray
ba1 ByteArray
ba2 = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  let n1 :: Int
n1 = ByteArray -> Int
sizeofByteArray ByteArray
ba1
      n2 :: Int
n2 = ByteArray -> Int
sizeofByteArray ByteArray
ba2
      totSz :: Int
totSz = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. [Char] -> a
sizeOverflowError [Char]
"appendByteArray")
                        (Int -> Int -> Maybe Int
checkedIntAdd Int
n1 Int
n2)
  marr <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
totSz
  unsafeCopyByteArray marr 0  ba1 0 n1
  unsafeCopyByteArray marr n1 ba2 0 n2
  unsafeFreezeByteArray marr

-- | Concatenate a list of 'ByteArray's.
concatByteArray :: [ByteArray] -> ByteArray
concatByteArray :: [ByteArray] -> ByteArray
concatByteArray [ByteArray]
arrs = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  let addLen :: Int -> ByteArray -> Int
addLen Int
acc ByteArray
arr = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. [Char] -> a
sizeOverflowError [Char]
"concatByteArray")
                                 (Int -> Int -> Maybe Int
checkedIntAdd Int
acc (ByteArray -> Int
sizeofByteArray ByteArray
arr))
      totLen :: Int
totLen = (Int -> ByteArray -> Int) -> Int -> [ByteArray] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Int -> ByteArray -> Int
addLen Int
0 [ByteArray]
arrs
  marr <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
totLen
  pasteByteArrays marr 0 arrs
  unsafeFreezeByteArray marr

-- | Dump immutable 'ByteArray's into a mutable one, starting from a given offset.
pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays :: forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays !MutableByteArray s
_ !Int
_ [] = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pasteByteArrays !MutableByteArray s
marr !Int
ix (ByteArray
x : [ByteArray]
xs) = do
  MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
unsafeCopyByteArray MutableByteArray s
marr Int
ix ByteArray
x Int
0 (ByteArray -> Int
sizeofByteArray ByteArray
x)
  MutableByteArray s -> Int -> [ByteArray] -> ST s ()
forall s. MutableByteArray s -> Int -> [ByteArray] -> ST s ()
pasteByteArrays MutableByteArray s
marr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteArray -> Int
sizeofByteArray ByteArray
x) [ByteArray]
xs

-- | An array of zero length.
emptyByteArray :: ByteArray
emptyByteArray :: ByteArray
emptyByteArray = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST (Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
0 ST s (MutableByteArray s)
-> (MutableByteArray s -> ST s ByteArray) -> ST s ByteArray
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableByteArray s -> ST s ByteArray
forall s. MutableByteArray s -> ST s ByteArray
unsafeFreezeByteArray)

-- | Concatenates a given number of copies of an input ByteArray.
stimesPolymorphic :: Integral t => t -> ByteArray -> ByteArray
{-# INLINABLE stimesPolymorphic #-}
stimesPolymorphic :: forall t. Integral t => t -> ByteArray -> ByteArray
stimesPolymorphic t
nRaw !ByteArray
arr = case t -> Integer
forall a. Integral a => a -> Integer
toInteger t
nRaw of
  IS Int#
nInt#
    | Int# -> Bool
isTrue# (Int#
nInt# Int# -> Int# -> Int#
>#  Int#
0#) -> Int -> ByteArray -> ByteArray
stimesPositiveInt (Int# -> Int
I# Int#
nInt#) ByteArray
arr
    | Int# -> Bool
isTrue# (Int#
nInt# Int# -> Int# -> Int#
>=# Int#
0#) -> ByteArray
emptyByteArray
      -- This check is redundant for unsigned types like Word.
      -- Using >=# intead of ==# may make it easier for GHC to notice that.
    | Bool
otherwise -> ByteArray
stimesNegativeErr
  IP ByteArray#
_
    | ByteArray -> Int
sizeofByteArray ByteArray
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ByteArray
emptyByteArray
    | Bool
otherwise -> ByteArray
forall a. a
stimesOverflowErr
  IN ByteArray#
_ -> ByteArray
stimesNegativeErr

stimesNegativeErr :: ByteArray
stimesNegativeErr :: ByteArray
stimesNegativeErr =
  [Char] -> ByteArray
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"stimes @ByteArray: negative multiplier"

stimesOverflowErr :: a
stimesOverflowErr :: forall a. a
stimesOverflowErr = [Char] -> a
forall a. [Char] -> a
sizeOverflowError [Char]
"stimes"

stimesPositiveInt :: Int -> ByteArray -> ByteArray
{-# NOINLINE stimesPositiveInt #-}
-- NOINLINE to prevent its duplication in specialisations of stimesPolymorphic
stimesPositiveInt :: Int -> ByteArray -> ByteArray
stimesPositiveInt Int
n ByteArray
arr = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  let inpSz :: Int
inpSz = ByteArray -> Int
sizeofByteArray ByteArray
arr
      tarSz :: Int
tarSz = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. a
stimesOverflowErr (Int -> Int -> Maybe Int
checkedIntMultiply Int
n Int
inpSz)
  marr <- Int -> ST s (MutableByteArray s)
forall s. Int -> ST s (MutableByteArray s)
newByteArray Int
tarSz
  unsafeCopyByteArray marr 0 arr 0 inpSz
  let
    halfTarSz = (Int
tarSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    go Int
copied
      | Int
copied Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
halfTarSz = do
          MutableByteArray s
-> Int -> MutableByteArray s -> Int -> Int -> ST s ()
forall s.
MutableByteArray s
-> Int -> MutableByteArray s -> Int -> Int -> ST s ()
unsafeCopyMutableByteArray MutableByteArray s
marr Int
copied MutableByteArray s
marr Int
0 Int
copied
          Int -> ST s ()
go (Int
copied Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
copied)
      | Bool
otherwise = MutableByteArray s
-> Int -> MutableByteArray s -> Int -> Int -> ST s ()
forall s.
MutableByteArray s
-> Int -> MutableByteArray s -> Int -> Int -> ST s ()
unsafeCopyMutableByteArray MutableByteArray s
marr Int
copied MutableByteArray s
marr Int
0 (Int
tarSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
copied)
  go inpSz
  unsafeFreezeByteArray marr

-- | @since 4.17.0.0
instance Semigroup ByteArray where
  <> :: ByteArray -> ByteArray -> ByteArray
(<>) = ByteArray -> ByteArray -> ByteArray
appendByteArray
  sconcat :: NonEmpty ByteArray -> ByteArray
sconcat = [ByteArray] -> ByteArray
forall a. Monoid a => [a] -> a
mconcat ([ByteArray] -> ByteArray)
-> (NonEmpty ByteArray -> [ByteArray])
-> NonEmpty ByteArray
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ByteArray -> [ByteArray]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  {-# INLINE stimes #-}
  stimes :: forall t. Integral t => t -> ByteArray -> ByteArray
stimes = b -> ByteArray -> ByteArray
forall t. Integral t => t -> ByteArray -> ByteArray
stimesPolymorphic

-- | @since 4.17.0.0
instance Monoid ByteArray where
  mempty :: ByteArray
mempty = ByteArray
emptyByteArray
  mconcat :: [ByteArray] -> ByteArray
mconcat = [ByteArray] -> ByteArray
concatByteArray

-- | @since 4.17.0.0
instance IsList ByteArray where
  type Item ByteArray = Word8

  toList :: ByteArray -> [Item ByteArray]
toList = ByteArray -> [Word8]
ByteArray -> [Item ByteArray]
byteArrayToList
  fromList :: [Item ByteArray] -> ByteArray
fromList [Item ByteArray]
xs = Int -> [Word8] -> ByteArray
byteArrayFromListN ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
[Item ByteArray]
xs) [Word8]
[Item ByteArray]
xs
  fromListN :: Int -> [Item ByteArray] -> ByteArray
fromListN = Int -> [Word8] -> ByteArray
Int -> [Item ByteArray] -> ByteArray
byteArrayFromListN


sizeOverflowError :: String -> a
sizeOverflowError :: forall a. [Char] -> a
sizeOverflowError [Char]
fun
  = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.Array.Byte." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": size overflow"


-- TODO: Export these from a better home.

-- | Adds two @Int@s, returning @Nothing@ if this results in an overflow
checkedIntAdd :: Int -> Int -> Maybe Int
checkedIntAdd :: Int -> Int -> Maybe Int
checkedIntAdd (I# Int#
x#) (I# Int#
y#) = case Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
x# Int#
y# of
  (# Int#
res, Int#
0# #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# Int#
res)
  (# Int#, Int# #)
_ -> Maybe Int
forall a. Maybe a
Nothing

-- | Multiplies two @Int@s, returning @Nothing@ if this results in an overflow
checkedIntMultiply :: Int -> Int -> Maybe Int
checkedIntMultiply :: Int -> Int -> Maybe Int
checkedIntMultiply (I# Int#
x#) (I# Int#
y#) = case Int# -> Int# -> (# Int#, Int#, Int# #)
timesInt2# Int#
x# Int#
y# of
  (# Int#
0#, Int#
_hi, Int#
lo #) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# Int#
lo)
  (# Int#, Int#, Int# #)
_ -> Maybe Int
forall a. Maybe a
Nothing