{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}

{- | If you are interested in sub-arrays of 'ByteArray's (e.g. writing a binary
search), it would be grossly inefficient to make a copy of the sub-array. On
the other hand, it'd be really annoying to track limit indices by hand.

This module defines the 'Bytes' type which exposes a standard array interface
for a sub-arrays without copying and without manual index manipulation. --
For mutable arrays, see 'Data.Bytes.Mutable'.
-}
module Data.Bytes
  ( -- * Types
    Bytes

    -- * Constants
  , Pure.empty
  , Pure.emptyPinned
  , Pure.emptyPinnedU

    -- * Properties
  , Pure.null
  , Pure.length

    -- * Decompose
  , uncons
  , unsnoc

    -- * Predicates
  , any
  , all

    -- * Create

    -- ** Sliced
  , singleton
  , doubleton
  , tripleton
  , Pure.replicate

    -- ** Unsliced
  , singletonU
  , doubletonU
  , tripletonU
  , Pure.replicateU

    -- * Filtering
  , takeWhile
  , dropWhile
  , takeWhileEnd
  , dropWhileEnd

    -- * Traversals
  , Pure.map
  , Pure.mapU

    -- * Folds
  , Pure.foldl
  , Pure.foldl'
  , Pure.foldr
  , Pure.foldr'

    -- * Folds with Indices
  , Pure.ifoldl'

    -- * Monadic Folds
  , Pure.foldlM
  , Pure.foldrM

    -- * Common Folds
  , elem

    -- * Splitting

    -- ** Unlimited
  , Byte.split
  , Byte.splitU
  , Byte.splitInit
  , Byte.splitInitU
  , Byte.splitNonEmpty
  , Byte.splitStream

    -- ** Fixed from Beginning
  , Byte.split1
  , splitTetragram1
  , Byte.split2
  , Byte.split3
  , Byte.split4

    -- ** Fixed from End
  , Byte.splitEnd1

    -- * Combining
  , intercalate
  , intercalateByte2
  , concatArray
  , concatArrayU

    -- * Searching
  , replace
  , findIndices
  , findTetragramIndex

    -- * Counting
  , Byte.count

    -- * Prefix and Suffix

    -- ** Byte Sequence
  , isPrefixOf
  , isSuffixOf
  , isInfixOf
  , stripPrefix
  , stripOptionalPrefix
  , stripSuffix
  , stripOptionalSuffix
  , longestCommonPrefix

    -- ** C Strings
  , stripCStringPrefix

    -- ** Single Byte
  , isBytePrefixOf
  , isByteSuffixOf

    -- * Equality

    -- ** Fixed Characters
  , equalsLatin1
  , equalsLatin2
  , equalsLatin3
  , equalsLatin4
  , equalsLatin5
  , equalsLatin6
  , equalsLatin7
  , equalsLatin8
  , equalsLatin9
  , equalsLatin10
  , equalsLatin11
  , equalsLatin12

    -- ** C Strings
  , equalsCString

    -- * Hashing
  , Pure.fnv1a32
  , Pure.fnv1a64

    -- * Unsafe Slicing
  , Pure.unsafeTake
  , Pure.unsafeDrop
  , Pure.unsafeIndex
  , Pure.unsafeHead

    -- * Copying
  , Pure.unsafeCopy

    -- * Pointers
  , Pure.pin
  , Pure.contents
  , touch

    -- * Conversion
  , Pure.toByteArray
  , Pure.toByteArrayClone
  , Pure.toPinnedByteArray
  , Pure.toPinnedByteArrayClone
  , fromAsciiString
  , fromLatinString
  , Pure.fromByteArray
  , Pure.fromPrimArray
  , toLatinString
  , fromCString#
  , Pure.toByteString
  , Pure.pinnedToByteString
  , Pure.fromByteString
  , Pure.fromLazyByteString
  , fromShortByteString
  , fromShortText
  , toShortByteString
  , toShortByteStringClone
  , toLowerAsciiByteArrayClone

    -- * I\/O with Handles
  , BIO.hGet
  , readFile
  , BIO.hPut

    -- * Unlifted Types
  , lift
  , unlift

    -- * Length Indexed
  , withLength
  , withLengthU
  ) where

import Prelude hiding (all, any, dropWhile, elem, foldl, foldr, length, map, null, readFile, replicate, takeWhile)

import Control.Monad.Primitive (PrimMonad, primitive_, unsafeIOToPrim)
import Control.Monad.ST.Run (runByteArrayST)
import Cstrlen (cstringLength#)
import Data.Bits (unsafeShiftL, (.|.))
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.Bytes.Pure (foldr, fromByteArray, length, toShortByteString, unsafeDrop, unsafeIndex)
import Data.Bytes.Search (findIndices, isInfixOf, replace)
import Data.Bytes.Types (ByteArrayN (ByteArrayN), Bytes (Bytes, array, offset), BytesN (BytesN))
import Data.Primitive (Array, ByteArray (ByteArray))
import Data.Text.Short (ShortText)
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import GHC.Exts (Addr#, Int (I#), Int#, Ptr (Ptr), Word#)
import GHC.Word (Word32, Word8 (W8#))
import Reps (Bytes# (..), word8ToWord#)

import qualified Arithmetic.Nat as Nat
import qualified Arithmetic.Types as Arithmetic
import qualified Data.Bytes.Byte as Byte
import qualified Data.Bytes.Chunks as Chunks
import qualified Data.Bytes.IO as BIO
import qualified Data.Bytes.Pure as Pure
import qualified Data.Bytes.Text.Ascii as Ascii
import qualified Data.Bytes.Text.AsciiExt as AsciiExt
import qualified Data.Bytes.Text.Latin1 as Latin1
import qualified Data.Bytes.Types as Types
import qualified Data.Foldable as F
import qualified Data.List as List
import qualified Data.Primitive as PM
import qualified Data.Primitive.Ptr as PM
import qualified Data.Text.Short as TS
import qualified GHC.Exts as Exts
import qualified GHC.TypeNats as GHC

{- | Extract the head and tail of the 'Bytes', returning 'Nothing' if
it is empty.
-}
uncons :: Bytes -> Maybe (Word8, Bytes)
{-# INLINE uncons #-}
uncons :: Bytes -> Maybe (Word8, Bytes)
uncons Bytes
b = case Bytes -> Int
length Bytes
b of
  Int
0 -> Maybe (Word8, Bytes)
forall a. Maybe a
Nothing
  Int
_ -> (Word8, Bytes) -> Maybe (Word8, Bytes)
forall a. a -> Maybe a
Just (Bytes -> Int -> Word8
unsafeIndex Bytes
b Int
0, Int -> Bytes -> Bytes
unsafeDrop Int
1 Bytes
b)

{- | Extract the @init@ and @last@ of the 'Bytes', returning 'Nothing' if
it is empty.
-}
unsnoc :: Bytes -> Maybe (Bytes, Word8)
{-# INLINE unsnoc #-}
unsnoc :: Bytes -> Maybe (Bytes, Word8)
unsnoc b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Int
len of
  Int
0 -> Maybe (Bytes, Word8)
forall a. Maybe a
Nothing
  Int
_ ->
    let !len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     in (Bytes, Word8) -> Maybe (Bytes, Word8)
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off Int
len', Bytes -> Int -> Word8
unsafeIndex Bytes
b Int
len')

{- | Does the byte sequence begin with the given byte? False if the
byte sequence is empty.
-}
isBytePrefixOf :: Word8 -> Bytes -> Bool
{-# INLINE isBytePrefixOf #-}
isBytePrefixOf :: Word8 -> Bytes -> Bool
isBytePrefixOf Word8
w Bytes
b = case Bytes -> Int
length Bytes
b of
  Int
0 -> Bool
False
  Int
_ -> Bytes -> Int -> Word8
unsafeIndex Bytes
b Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w

{- | Does the byte sequence end with the given byte? False if the
byte sequence is empty.
-}
isByteSuffixOf :: Word8 -> Bytes -> Bool
isByteSuffixOf :: Word8 -> Bytes -> Bool
isByteSuffixOf Word8
w Bytes
b = case Int
len of
  Int
0 -> Bool
False
  Int
_ -> Bytes -> Int -> Word8
unsafeIndex Bytes
b (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w
 where
  len :: Int
len = Bytes -> Int
length Bytes
b

-- | Is the first argument a prefix of the second argument?
isPrefixOf :: Bytes -> Bytes -> Bool
isPrefixOf :: Bytes -> Bytes -> Bool
isPrefixOf (Bytes ByteArray
a Int
aOff Int
aLen) (Bytes ByteArray
b Int
bOff Int
bLen) =
  -- For prefix and suffix testing, we do not use
  -- the sameByteArray optimization that we use in
  -- the Eq instance. Prefix and suffix testing seldom
  -- compares a byte array with the same in-memory
  -- byte array.
  if Int
aLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bLen
    then ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering
compareByteArrays ByteArray
a Int
aOff ByteArray
b Int
bOff Int
aLen Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    else Bool
False

-- | Is the first argument a suffix of the second argument?
isSuffixOf :: Bytes -> Bytes -> Bool
isSuffixOf :: Bytes -> Bytes -> Bool
isSuffixOf (Bytes ByteArray
a Int
aOff Int
aLen) (Bytes ByteArray
b Int
bOff Int
bLen) =
  if Int
aLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bLen
    then ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering
compareByteArrays ByteArray
a Int
aOff ByteArray
b (Int
bOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aLen) Int
aLen Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
    else Bool
False

-- | Find the longest string which is a prefix of both arguments.
longestCommonPrefix :: Bytes -> Bytes -> Bytes
longestCommonPrefix :: Bytes -> Bytes -> Bytes
longestCommonPrefix Bytes
a Bytes
b = Int -> Bytes
loop Int
0
 where
  loop :: Int -> Bytes
  loop :: Int -> Bytes
loop !Int
into
    | Int
into Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxLen
        Bool -> Bool -> Bool
&& Bytes -> Int -> Word8
unsafeIndex Bytes
a Int
into Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes -> Int -> Word8
unsafeIndex Bytes
b Int
into =
        Int -> Bytes
loop (Int
into Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise = Int -> Bytes -> Bytes
Pure.unsafeTake Int
into Bytes
a
  maxLen :: Int
maxLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Bytes -> Int
length Bytes
a) (Bytes -> Int
length Bytes
b)

-- | Create a byte sequence with one byte.
singleton :: Word8 -> Bytes
{-# INLINE singleton #-}
singleton :: Word8 -> Bytes
singleton !Word8
a = ByteArray -> Int -> Int -> Bytes
Bytes (Word8 -> ByteArray
singletonU Word8
a) Int
0 Int
1

-- | Create a byte sequence with two bytes.
doubleton :: Word8 -> Word8 -> Bytes
{-# INLINE doubleton #-}
doubleton :: Word8 -> Word8 -> Bytes
doubleton !Word8
a !Word8
b = ByteArray -> Int -> Int -> Bytes
Bytes (Word8 -> Word8 -> ByteArray
doubletonU Word8
a Word8
b) Int
0 Int
2

-- | Create a byte sequence with three bytes.
tripleton :: Word8 -> Word8 -> Word8 -> Bytes
{-# INLINE tripleton #-}
tripleton :: Word8 -> Word8 -> Word8 -> Bytes
tripleton !Word8
a !Word8
b !Word8
c = ByteArray -> Int -> Int -> Bytes
Bytes (Word8 -> Word8 -> Word8 -> ByteArray
tripletonU Word8
a Word8
b Word8
c) Int
0 Int
3

-- | Create an unsliced byte sequence with one byte.
singletonU :: Word8 -> ByteArray
{-# INLINE singletonU #-}
singletonU :: Word8 -> ByteArray
singletonU !Word8
a = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
1
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 Word8
a
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr

-- | Create an unsliced byte sequence with two bytes.
doubletonU :: Word8 -> Word8 -> ByteArray
{-# INLINE doubletonU #-}
doubletonU :: Word8 -> Word8 -> ByteArray
doubletonU !Word8
a !Word8
b = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
2
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 Word8
a
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
1 Word8
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))
arr

-- | Create an unsliced byte sequence with three bytes.
tripletonU :: Word8 -> Word8 -> Word8 -> ByteArray
{-# INLINE tripletonU #-}
tripletonU :: Word8 -> Word8 -> Word8 -> ByteArray
tripletonU !Word8
a !Word8
b !Word8
c = (forall s. ST s ByteArray) -> ByteArray
runByteArrayST do
  MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
3
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
0 Word8
a
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
1 Word8
b
  MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
2 Word8
c
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr

{- | /O(n)/ Return the suffix of the second string if its prefix
matches the entire first string.
-}
stripPrefix :: Bytes -> Bytes -> Maybe Bytes
stripPrefix :: Bytes -> Bytes -> Maybe Bytes
stripPrefix !Bytes
pre !Bytes
str =
  if Bytes
pre Bytes -> Bytes -> Bool
`isPrefixOf` Bytes
str
    then Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes (Bytes -> ByteArray
array Bytes
str) (Bytes -> Int
offset Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
length Bytes
pre) (Bytes -> Int
length Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
length Bytes
pre))
    else Maybe Bytes
forall a. Maybe a
Nothing

{- | /O(n)/ Return the suffix of the second string if its prefix
matches the entire first string. Otherwise, return the second
string unchanged.
-}
stripOptionalPrefix :: Bytes -> Bytes -> Bytes
stripOptionalPrefix :: Bytes -> Bytes -> Bytes
stripOptionalPrefix !Bytes
pre !Bytes
str =
  if Bytes
pre Bytes -> Bytes -> Bool
`isPrefixOf` Bytes
str
    then ByteArray -> Int -> Int -> Bytes
Bytes (Bytes -> ByteArray
array Bytes
str) (Bytes -> Int
offset Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
length Bytes
pre) (Bytes -> Int
length Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
length Bytes
pre)
    else Bytes
str

{- | /O(n)/ Return the prefix of the second string if its suffix
matches the entire first string.
-}
stripSuffix :: Bytes -> Bytes -> Maybe Bytes
stripSuffix :: Bytes -> Bytes -> Maybe Bytes
stripSuffix !Bytes
suf !Bytes
str =
  if Bytes
suf Bytes -> Bytes -> Bool
`isSuffixOf` Bytes
str
    then Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes (Bytes -> ByteArray
array Bytes
str) (Bytes -> Int
offset Bytes
str) (Bytes -> Int
length Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
length Bytes
suf))
    else Maybe Bytes
forall a. Maybe a
Nothing

{- | /O(n)/ Return the prefix of the second string if its suffix
matches the entire first string. Otherwise, return the second
string unchanged.
-}
stripOptionalSuffix :: Bytes -> Bytes -> Bytes
stripOptionalSuffix :: Bytes -> Bytes -> Bytes
stripOptionalSuffix !Bytes
suf !Bytes
str =
  if Bytes
suf Bytes -> Bytes -> Bool
`isSuffixOf` Bytes
str
    then ByteArray -> Int -> Int -> Bytes
Bytes (Bytes -> ByteArray
array Bytes
str) (Bytes -> Int
offset Bytes
str) (Bytes -> Int
length Bytes
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
length Bytes
suf)
    else Bytes
str

-- | Is the byte a member of the byte sequence?
elem :: Word8 -> Bytes -> Bool
elem :: Word8 -> Bytes -> Bool
elem (W8# Word8#
w) Bytes
b = case Int# -> Word# -> Bytes -> Int#
elemLoop Int#
0# (Word8# -> Word#
word8ToWord# Word8#
w) Bytes
b of
  Int#
1# -> Bool
True
  Int#
_ -> Bool
False

elemLoop :: Int# -> Word# -> Bytes -> Int#
elemLoop :: Int# -> Word# -> Bytes -> Int#
elemLoop !Int#
r !Word#
w (Bytes arr :: ByteArray
arr@(ByteArray ByteArray#
arr#) off :: Int
off@(I# Int#
off#) Int
len) = case Int
len of
  Int
0 -> Int#
r
  Int
_ -> Int# -> Word# -> Bytes -> Int#
elemLoop (Int# -> Int# -> Int#
Exts.orI# Int#
r (Word# -> Word# -> Int#
Exts.eqWord# Word#
w (Word8# -> Word#
word8ToWord# (ByteArray# -> Int# -> Word8#
Exts.indexWord8Array# ByteArray#
arr# Int#
off#)))) Word#
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

-- | Take bytes while the predicate is true.
takeWhile :: (Word8 -> Bool) -> Bytes -> Bytes
{-# INLINE takeWhile #-}
takeWhile :: (Word8 -> Bool) -> Bytes -> Bytes
takeWhile Word8 -> Bool
k Bytes
b = Int -> Bytes -> Bytes
Pure.unsafeTake ((Word8 -> Bool) -> Bytes -> Int
countWhile Word8 -> Bool
k Bytes
b) Bytes
b

-- | Drop bytes while the predicate is true.
dropWhile :: (Word8 -> Bool) -> Bytes -> Bytes
{-# INLINE dropWhile #-}
dropWhile :: (Word8 -> Bool) -> Bytes -> Bytes
dropWhile Word8 -> Bool
k Bytes
b = Int -> Bytes -> Bytes
Pure.unsafeDrop ((Word8 -> Bool) -> Bytes -> Int
countWhile Word8 -> Bool
k Bytes
b) Bytes
b

{- | /O(n)/ 'dropWhileEnd' @p@ @b@ returns the prefix remaining after
dropping characters that satisfy the predicate @p@ from the end of
@t@.
-}
dropWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes
{-# INLINE dropWhileEnd #-}
dropWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes
dropWhileEnd Word8 -> Bool
k !Bytes
b = Int -> Bytes -> Bytes
Pure.unsafeTake (Bytes -> Int
length Bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Word8 -> Bool) -> Bytes -> Int
countWhileEnd Word8 -> Bool
k Bytes
b) Bytes
b

{- | /O(n)/ 'takeWhileEnd' @p@ @b@ returns the longest suffix of
elements that satisfy predicate @p@.
-}
takeWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes
{-# INLINE takeWhileEnd #-}
takeWhileEnd :: (Word8 -> Bool) -> Bytes -> Bytes
takeWhileEnd Word8 -> Bool
k !Bytes
b =
  let n :: Int
n = (Word8 -> Bool) -> Bytes -> Int
countWhileEnd Word8 -> Bool
k Bytes
b
   in ByteArray -> Int -> Int -> Bytes
Bytes (Bytes -> ByteArray
array Bytes
b) (Bytes -> Int
offset Bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
length Bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Int
n

-- Internal. The returns the number of bytes that match the
-- predicate until the first non-match occurs. If all bytes
-- match the predicate, this will return the length originally
-- provided.
countWhile :: (Word8 -> Bool) -> Bytes -> Int
{-# INLINE countWhile #-}
countWhile :: (Word8 -> Bool) -> Bytes -> Int
countWhile Word8 -> Bool
k (Bytes ByteArray
arr Int
off0 Int
len0) = Int -> Int -> Int -> Int
forall {t} {t}. (Ord t, Num t, Num t) => Int -> t -> t -> t
go Int
off0 Int
len0 Int
0
 where
  go :: Int -> t -> t -> t
go !Int
off !t
len !t
n =
    if t
len t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0
      then
        if Word8 -> Bool
k (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)
          then Int -> t -> t -> t
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) (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
          else t
n
      else t
n

-- Internal. Variant of countWhile that starts from the end
-- of the string instead of the beginning.
countWhileEnd :: (Word8 -> Bool) -> Bytes -> Int
{-# INLINE countWhileEnd #-}
countWhileEnd :: (Word8 -> Bool) -> Bytes -> Int
countWhileEnd Word8 -> Bool
k (Bytes ByteArray
arr Int
off0 Int
len0) = Int -> Int -> Int -> Int
forall {t} {t}. (Ord t, Num t, Num t) => Int -> t -> t -> t
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) Int
0
 where
  go :: Int -> t -> t -> t
go !Int
off !t
len !t
n =
    if t
len t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0
      then
        if Word8 -> Bool
k (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off)
          then Int -> t -> t -> t
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) (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
          else t
n
      else t
n

{- | Convert a 'String' consisting of only characters in the ASCII block
to a byte sequence. Any character with a codepoint above @U+007F@ is
replaced by @U+0000@.
-}
fromAsciiString :: String -> Bytes
{-# DEPRECATED fromAsciiString "use Data.Bytes.Text.Ascii.fromString instead" #-}
{-# INLINE fromAsciiString #-}
fromAsciiString :: String -> Bytes
fromAsciiString = String -> Bytes
Ascii.fromString

{- | Convert a 'String' consisting of only characters representable
by ISO-8859-1. These are encoded with ISO-8859-1. Any character
with a codepoint above @U+00FF@ is replaced by an unspecified byte.
-}
fromLatinString :: String -> Bytes
{-# DEPRECATED fromLatinString "use Data.Bytes.Text.Latin1.fromString instead" #-}
{-# INLINE fromLatinString #-}
fromLatinString :: String -> Bytes
fromLatinString = String -> Bytes
Latin1.fromString

-- | Interpret a byte sequence as text encoded by ISO-8859-1.
toLatinString :: Bytes -> String
{-# DEPRECATED toLatinString "use Data.Bytes.Text.Latin1.toString instead" #-}
{-# INLINE toLatinString #-}
toLatinString :: Bytes -> String
toLatinString = Bytes -> String
Latin1.toString

-- | Copy a primitive string literal into managed memory.
fromCString# :: Addr# -> Bytes
fromCString# :: Addr# -> Bytes
fromCString# Addr#
a =
  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
$ do
        dst :: MutableByteArray s
dst@(PM.MutableByteArray MutableByteArray# s
dst#) <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
len
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Ptr Word8 -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
PM.copyPtrToMutablePrimArray
          (MutableByteArray# s -> MutablePrimArray s Word8
forall s a. MutableByteArray# s -> MutablePrimArray s a
PM.MutablePrimArray MutableByteArray# s
dst#)
          Int
0
          (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
a :: Ptr Word8)
          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))
dst
    )
    Int
0
    Int
len
 where
  len :: Int
len = Int# -> Int
I# (Addr# -> Int#
cstringLength# Addr#
a)

compareByteArrays :: ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering
{-# INLINE compareByteArrays #-}
compareByteArrays :: ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering
compareByteArrays (ByteArray ByteArray#
ba1#) (I# Int#
off1#) (ByteArray ByteArray#
ba2#) (I# Int#
off2#) (I# Int#
n#) =
  Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
Exts.compareByteArrays# ByteArray#
ba1# Int#
off1# ByteArray#
ba2# Int#
off2# Int#
n#)) Int
0

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a singleton whose element matches the character?
-}
equalsLatin1 :: Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin1 "use Data.Bytes.Text.Latin1.equals1 instead" #-}
{-# INLINE equalsLatin1 #-}
equalsLatin1 :: Char -> Bytes -> Bool
equalsLatin1 = Char -> Bytes -> Bool
Latin1.equals1

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a doubleton whose elements match the characters?
-}
equalsLatin2 :: Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin2 "use Data.Bytes.Text.Latin1.equals2 instead" #-}
{-# INLINE equalsLatin2 #-}
equalsLatin2 :: Char -> Char -> Bytes -> Bool
equalsLatin2 = Char -> Char -> Bytes -> Bool
Latin1.equals2

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a tripleton whose elements match the characters?
-}
equalsLatin3 :: Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin3 "use Data.Bytes.Text.Latin1.equals3 instead" #-}
{-# INLINE equalsLatin3 #-}
equalsLatin3 :: Char -> Char -> Char -> Bytes -> Bool
equalsLatin3 = Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a quadrupleton whose elements match the characters?
-}
equalsLatin4 :: Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin4 "use Data.Bytes.Text.Latin1.equals4 instead" #-}
{-# INLINE equalsLatin4 #-}
equalsLatin4 :: Char -> Char -> Char -> Char -> Bytes -> Bool
equalsLatin4 = Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals4

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a quintupleton whose elements match the characters?
-}
equalsLatin5 :: Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin5 "use Data.Bytes.Text.Latin1.equals5 instead" #-}
{-# INLINE equalsLatin5 #-}
equalsLatin5 :: Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
equalsLatin5 = Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a sextupleton whose elements match the characters?
-}
equalsLatin6 :: Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin6 "use Data.Bytes.Text.Latin1.equals6 instead" #-}
{-# INLINE equalsLatin6 #-}
equalsLatin6 :: Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
equalsLatin6 = Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals6

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a septupleton whose elements match the characters?
-}
equalsLatin7 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin7 "use Data.Bytes.Text.Latin1.equals7 instead" #-}
{-# INLINE equalsLatin7 #-}
equalsLatin7 :: Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
equalsLatin7 = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals7

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
an octupleton whose elements match the characters?
-}
equalsLatin8 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin8 "use Data.Bytes.Text.Latin1.equals8 instead" #-}
{-# INLINE equalsLatin8 #-}
equalsLatin8 :: Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
equalsLatin8 = Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
Latin1.equals8

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a 9-tuple whose elements match the characters?
-}
equalsLatin9 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin9 "use Data.Bytes.Text.Latin1.equals9 instead" #-}
{-# INLINE equalsLatin9 #-}
equalsLatin9 :: Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
equalsLatin9 = Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
Latin1.equals9

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a 10-tuple whose elements match the characters?
-}
equalsLatin10 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin10 "use Data.Bytes.Text.Latin1.equals10 instead" #-}
{-# INLINE equalsLatin10 #-}
equalsLatin10 :: Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
equalsLatin10 = Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
Latin1.equals10

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a 11-tuple whose elements match the characters?
-}
equalsLatin11 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin11 "use Data.Bytes.Text.Latin1.equals11 instead" #-}
{-# INLINE equalsLatin11 #-}
equalsLatin11 :: Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
equalsLatin11 = Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
Latin1.equals11

{- | Is the byte sequence, when interpreted as ISO-8859-1-encoded text,
a 12-tuple whose elements match the characters?
-}
equalsLatin12 :: Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
{-# DEPRECATED equalsLatin12 "use Data.Bytes.Text.Latin1.equals12 instead" #-}
{-# INLINE equalsLatin12 #-}
equalsLatin12 :: Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
equalsLatin12 = Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Char
-> Bytes
-> Bool
Latin1.equals12

{- | Is the byte sequence equal to the @NUL@-terminated C String?
The C string must be a constant.
-}
equalsCString :: CString -> Bytes -> Bool
{-# INLINE equalsCString #-}
equalsCString :: CString -> Bytes -> Bool
equalsCString !CString
ptr0 (Bytes ByteArray
arr Int
off0 Int
len0) = Ptr Word8 -> Int -> Int -> Bool
forall {t}. (Eq t, Num t) => Ptr Word8 -> Int -> t -> Bool
go (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr0 :: Ptr Word8) Int
off0 Int
len0
 where
  go :: Ptr Word8 -> Int -> t -> Bool
go !Ptr Word8
ptr !Int
off !t
len = case t
len of
    t
0 -> Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
PM.indexOffPtr Ptr Word8
ptr Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word8
0 :: Word8)
    t
_ -> case Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
PM.indexOffPtr Ptr Word8
ptr Int
0 of
      Word8
0 -> Bool
False
      Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off Bool -> Bool -> Bool
&& Ptr Word8 -> Int -> t -> Bool
go (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr 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)

{- | /O(n)/ Variant of 'stripPrefix' that takes a @NUL@-terminated C String
as the prefix to test for.
-}
stripCStringPrefix :: CString -> Bytes -> Maybe Bytes
{-# INLINE stripCStringPrefix #-}
stripCStringPrefix :: CString -> Bytes -> Maybe Bytes
stripCStringPrefix !CString
ptr0 (Bytes ByteArray
arr Int
off0 Int
len0) = Ptr Word8 -> Int -> Int -> Maybe Bytes
forall {b}.
(Prim b, Eq b, Num b) =>
Ptr b -> Int -> Int -> Maybe Bytes
go (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr0 :: Ptr Word8) Int
off0 Int
len0
 where
  go :: Ptr b -> Int -> Int -> Maybe Bytes
go !Ptr b
ptr !Int
off !Int
len = case Ptr b -> Int -> b
forall a. Prim a => Ptr a -> Int -> a
PM.indexOffPtr Ptr b
ptr Int
0 of
    b
0 -> Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off Int
len)
    b
c -> case Int
len of
      Int
0 -> Maybe Bytes
forall a. Maybe a
Nothing
      Int
_ -> case b
c b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray -> Int -> b
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off of
        Bool
True -> Ptr b -> Int -> Int -> Maybe Bytes
go (Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr b
ptr Int
1) (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Bool
False -> Maybe Bytes
forall a. Maybe a
Nothing

{- | Touch the byte array backing the byte sequence. This sometimes needed
after calling 'Pure.contents' so that the @ByteArray@ does not get garbage
collected.
-}
touch :: (PrimMonad m) => Bytes -> m ()
touch :: forall (m :: * -> *). PrimMonad m => Bytes -> m ()
touch (Bytes (ByteArray ByteArray#
arr) Int
_ Int
_) =
  IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim
    ((State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (\State# (PrimState IO)
s -> ByteArray# -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
Exts.touch# ByteArray#
arr State# RealWorld
State# (PrimState IO)
s))

-- | Read an entire file strictly into a 'Bytes'.
readFile :: FilePath -> IO Bytes
readFile :: String -> IO Bytes
readFile String
f = Chunks -> Bytes
Chunks.concat (Chunks -> Bytes) -> IO Chunks -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Chunks
Chunks.readFile String
f

{- | /O(n)/ The intercalate function takes a separator 'Bytes' and a list of
'Bytes' and concatenates the list elements by interspersing the separator
between each element.
-}
intercalate ::
  -- | Separator (interspersed into the list)
  Bytes ->
  -- | List
  [Bytes] ->
  Bytes
intercalate :: Bytes -> [Bytes] -> Bytes
intercalate !Bytes
_ [] = Bytes
forall a. Monoid a => a
mempty
intercalate !Bytes
_ [Bytes
x] = Bytes
x
intercalate (Bytes ByteArray
sarr Int
soff Int
slen) (Bytes ByteArray
arr0 Int
off0 Int
len0 : [Bytes]
bs) = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
r Int
0 Int
fullLen
 where
  !fullLen :: Int
fullLen = (Int -> Bytes -> Int) -> Int -> [Bytes] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Int
acc (Bytes ByteArray
_ Int
_ Int
len) -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen) Int
0 [Bytes]
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0
  r :: ByteArray
r = (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
marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
fullLen
    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))
marr Int
0 ByteArray
arr0 Int
off0 Int
len0
    !Int
_ <-
      (Int -> Bytes -> ST s Int) -> Int -> [Bytes] -> ST s Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM
        ( \ !Int
currLen (Bytes ByteArray
arr Int
off Int
len) -> do
            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))
marr Int
currLen ByteArray
sarr Int
soff Int
slen
            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))
marr (Int
currLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen) ByteArray
arr Int
off Int
len
            Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
currLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slen)
        )
        Int
len0
        [Bytes]
bs
    MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr

{- | Specialization of 'intercalate' where the separator is a single byte and
there are exactly two byte sequences that are being concatenated.
-}
intercalateByte2 ::
  -- | Separator
  Word8 ->
  -- | First byte sequence
  Bytes ->
  -- | Second byte sequence
  Bytes ->
  Bytes
intercalateByte2 :: Word8 -> Bytes -> Bytes -> Bytes
intercalateByte2 !Word8
sep !Bytes
a !Bytes
b =
  Bytes
    { $sel:array:Bytes :: ByteArray
Types.array = (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
dst <- 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 -> Bytes -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Bytes -> m ()
Pure.unsafeCopy MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 Bytes
a
        MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst (Bytes -> Int
length Bytes
a) Word8
sep
        MutableByteArray (PrimState (ST s)) -> Int -> Bytes -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Bytes -> m ()
Pure.unsafeCopy MutableByteArray s
MutableByteArray (PrimState (ST s))
dst (Bytes -> Int
length Bytes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 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
    , $sel:length:Bytes :: Int
Types.length = Int
len
    , $sel:offset:Bytes :: Int
Types.offset = Int
0
    }
 where
  len :: Int
len = Bytes -> Int
length Bytes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
length Bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | /O(n)/ Returns true if any byte in the sequence satisfies the predicate.
any :: (Word8 -> Bool) -> Bytes -> Bool
{-# INLINE any #-}
any :: (Word8 -> Bool) -> Bytes -> Bool
any Word8 -> Bool
f = (Word8 -> Bool -> Bool) -> Bool -> Bytes -> Bool
forall a. (Word8 -> a -> a) -> a -> Bytes -> a
foldr (\Word8
b Bool
r -> Word8 -> Bool
f Word8
b Bool -> Bool -> Bool
|| Bool
r) Bool
False

-- | /O(n)/ Returns true if all bytes in the sequence satisfy the predicate.
all :: (Word8 -> Bool) -> Bytes -> Bool
{-# INLINE all #-}
all :: (Word8 -> Bool) -> Bytes -> Bool
all Word8 -> Bool
f = (Word8 -> Bool -> Bool) -> Bool -> Bytes -> Bool
forall a. (Word8 -> a -> a) -> a -> Bytes -> a
foldr (\Word8
b Bool
r -> Word8 -> Bool
f Word8
b Bool -> Bool -> Bool
&& Bool
r) Bool
True

{- | Variant of 'toShortByteString' that unconditionally makes a copy of
the array backing the sliced 'Bytes' even if the original array
could be reused. Prefer 'toShortByteString'.
-}
toShortByteStringClone :: Bytes -> ShortByteString
{-# INLINE toShortByteStringClone #-}
toShortByteStringClone :: Bytes -> ShortByteString
toShortByteStringClone !Bytes
b = case Bytes -> ByteArray
Pure.toByteArrayClone Bytes
b of
  PM.ByteArray ByteArray#
x -> ByteArray# -> ShortByteString
SBS ByteArray#
x

-- | /O(1)/ Create 'Bytes' from a 'ShortByteString'.
fromShortByteString :: ShortByteString -> Bytes
{-# INLINE fromShortByteString #-}
fromShortByteString :: ShortByteString -> Bytes
fromShortByteString (SBS ByteArray#
x) = ByteArray -> Bytes
fromByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
x)

{- | /O(1)/ Create 'Bytes' from a 'ShortText'. This encodes the text as UTF-8.
It is a no-op.
-}
fromShortText :: ShortText -> Bytes
{-# INLINE fromShortText #-}
fromShortText :: ShortText -> Bytes
fromShortText ShortText
t = case ShortText -> ShortByteString
TS.toShortByteString ShortText
t of
  SBS ByteArray#
x -> ByteArray -> Bytes
fromByteArray (ByteArray# -> ByteArray
ByteArray ByteArray#
x)

{- | /O(n)/ Interpreting the bytes an ASCII-encoded characters, convert
the string to lowercase. This adds @0x20@ to bytes in the range
@[0x41,0x5A]@ and leaves all other bytes alone. Unconditionally
copies the bytes.
-}
toLowerAsciiByteArrayClone :: Bytes -> ByteArray
{-# DEPRECATED toLowerAsciiByteArrayClone "use Data.Bytes/Text/AsciiExt.toLowerU" #-}
{-# INLINE toLowerAsciiByteArrayClone #-}
toLowerAsciiByteArrayClone :: Bytes -> ByteArray
toLowerAsciiByteArrayClone = Bytes -> ByteArray
AsciiExt.toLowerU

lift :: Bytes# -> Bytes
{-# INLINE lift #-}
lift :: Bytes# -> Bytes
lift (Bytes# (# ByteArray#
arr, Int#
off, Int#
len #)) = ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# Int#
len)

unlift :: Bytes -> Bytes#
{-# INLINE unlift #-}
unlift :: Bytes -> Bytes#
unlift (Bytes (ByteArray ByteArray#
arr) (I# Int#
off) (I# Int#
len)) =
  (# ByteArray#, Int#, Int# #) -> Bytes#
Bytes# (# ByteArray#
arr, Int#
off, Int#
len #)

concatArrayU :: Array Bytes -> ByteArray
{-# NOINLINE concatArrayU #-}
concatArrayU :: Array Bytes -> ByteArray
concatArrayU !Array Bytes
xs = (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
  let !arrLen :: Int
arrLen = Array Bytes -> Int
forall a. Array a -> Int
PM.sizeofArray Array Bytes
xs
  let !totalByteLen :: Int
totalByteLen = (Int -> Bytes -> Int) -> Int -> Array Bytes -> Int
forall b a. (b -> a -> b) -> b -> Array a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\Int
acc Bytes
b -> Bytes -> Int
length Bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) Int
0 Array Bytes
xs
  MutableByteArray (PrimState (ST s))
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
totalByteLen
  let go :: Int -> Int -> ST s ByteArray
go !Int
ix !Int
dstOff =
        if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrLen
          then do
            Bytes
x <- Array Bytes -> Int -> ST s Bytes
forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
PM.indexArrayM Array Bytes
xs Int
ix
            MutableByteArray (PrimState (ST s)) -> Int -> Bytes -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Bytes -> m ()
Pure.unsafeCopy MutableByteArray (PrimState (ST s))
dst Int
dstOff Bytes
x
            Int -> Int -> ST s ByteArray
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
length Bytes
x)
          else MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray (PrimState (ST s))
dst
  Int -> Int -> ST s ByteArray
go Int
0 Int
0

concatArray :: Array Bytes -> Bytes
{-# INLINE concatArray #-}
concatArray :: Array Bytes -> Bytes
concatArray !Array Bytes
xs = ByteArray -> Bytes
Pure.fromByteArray (Array Bytes -> ByteArray
concatArrayU Array Bytes
xs)

{- | Convert 'Bytes' to 'BytesN', exposing the length in a type-safe
way in the callback.
-}
withLength ::
  Bytes ->
  (forall (n :: GHC.Nat). Arithmetic.Nat n -> BytesN n -> a) ->
  a
{-# INLINE withLength #-}
withLength :: forall a. Bytes -> (forall (n :: Nat). Nat n -> BytesN n -> a) -> a
withLength Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, Int
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
offset, $sel:length:Bytes :: Bytes -> Int
length = Int
len} forall (n :: Nat). Nat n -> BytesN n -> a
f =
  Int -> (forall (n :: Nat). Nat n -> a) -> a
forall a. Int -> (forall (n :: Nat). Nat n -> a) -> a
Nat.with
    Int
len
    (\Nat n
n -> Nat n -> BytesN n -> a
forall (n :: Nat). Nat n -> BytesN n -> a
f Nat n
n BytesN {ByteArray
array :: ByteArray
$sel:array:BytesN :: ByteArray
array, Int
offset :: Int
$sel:offset:BytesN :: Int
offset})

withLengthU ::
  ByteArray ->
  (forall (n :: GHC.Nat). Arithmetic.Nat n -> ByteArrayN n -> a) ->
  a
{-# INLINE withLengthU #-}
withLengthU :: forall a.
ByteArray -> (forall (n :: Nat). Nat n -> ByteArrayN n -> a) -> a
withLengthU !ByteArray
arr forall (n :: Nat). Nat n -> ByteArrayN n -> a
f =
  Int -> (forall (n :: Nat). Nat n -> a) -> a
forall a. Int -> (forall (n :: Nat). Nat n -> a) -> a
Nat.with
    (ByteArray -> Int
PM.sizeofByteArray ByteArray
arr)
    (\Nat n
n -> Nat n -> ByteArrayN n -> a
forall (n :: Nat). Nat n -> ByteArrayN n -> a
f Nat n
n (ByteArray -> ByteArrayN n
forall (n :: Nat). ByteArray -> ByteArrayN n
ByteArrayN ByteArray
arr))

findTetragramIndex ::
  Word8 ->
  Word8 ->
  Word8 ->
  Word8 ->
  Bytes ->
  Maybe Int
findTetragramIndex :: Word8 -> Word8 -> Word8 -> Word8 -> Bytes -> Maybe Int
findTetragramIndex !Word8
w0 !Word8
w1 !Word8
w2 !Word8
w3 (Bytes ByteArray
arr Int
off Int
len) =
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
    then Maybe Int
forall a. Maybe a
Nothing
    else
      let !target :: Word32
target =
            Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w0 :: Word32) Int
24
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1 :: Word32) Int
16
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2 :: Word32) Int
8
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3 :: Word32) Int
0
          !end :: Int
end = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
          go :: Int -> Word32 -> Maybe Int
go !Int
ix !Word32
acc =
            if Word32
acc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
target
              then
                let n :: Int
n = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
                 in Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
              else
                if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end
                  then
                    let !w :: Word8
w = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
ix :: Word8
                        acc' :: Word32
acc' =
                          (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w :: Word32)
                            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL Word32
acc Int
8
                     in Int -> Word32 -> Maybe Int
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
acc'
                  else Maybe Int
forall a. Maybe a
Nothing
          !acc0 :: Word32
acc0 =
            Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
0 :: Word8) :: Word32) Int
24
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
1 :: Word8) :: Word32) Int
16
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
2 :: Word8) :: Word32) Int
8
              Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
3 :: Word8) :: Word32) Int
0
       in Int -> Word32 -> Maybe Int
go Int
4 Word32
acc0

splitTetragram1 ::
  Word8 ->
  Word8 ->
  Word8 ->
  Word8 ->
  Bytes ->
  Maybe (Bytes, Bytes)
splitTetragram1 :: Word8 -> Word8 -> Word8 -> Word8 -> Bytes -> Maybe (Bytes, Bytes)
splitTetragram1 !Word8
w0 !Word8
w1 !Word8
w2 !Word8
w3 !Bytes
b = case Word8 -> Word8 -> Word8 -> Word8 -> Bytes -> Maybe Int
findTetragramIndex Word8
w0 Word8
w1 Word8
w2 Word8
w3 Bytes
b of
  Maybe Int
Nothing -> Maybe (Bytes, Bytes)
forall a. Maybe a
Nothing
  Just Int
n -> (Bytes, Bytes) -> Maybe (Bytes, Bytes)
forall a. a -> Maybe a
Just (Int -> Bytes -> Bytes
Pure.unsafeTake Int
n Bytes
b, Int -> Bytes -> Bytes
Pure.unsafeDrop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Bytes
b)