{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnliftedFFITypes #-}

-- This internal module has functions for splitting strings
-- on a particular byte and for counting occurences of that
-- byte.
module Data.Bytes.Byte
  ( -- Re-exported by Data.Bytes
    count
  , split
  , splitU
  , splitNonEmpty
  , splitStream
  , splitInit
  , splitInitU
  , split1
  , split2
  , split3
  , split4
  , splitEnd1
  -- Used by other internal modules
  , elemIndexLoop#
  ) where

import Prelude hiding (length)

import Control.Monad.ST (runST)
import Control.Monad.ST.Run (runPrimArrayST)
import Data.Bytes.Types (Bytes (..))
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Primitive (ByteArray (..), MutablePrimArray (..), PrimArray (..))
import Data.Primitive.Unlifted.Array (UnliftedArray)
import Data.Tuple.Types (IntPair (IntPair))
import Data.Vector.Fusion.Stream.Monadic (Step (Done, Yield), Stream (Stream))
import Data.Word (Word8)
import GHC.Exts (ByteArray#, Int (I#), Int#, MutableByteArray#)
import GHC.IO (unsafeIOToST)

import qualified Data.Primitive as PM
import qualified Data.Primitive.Unlifted.Array as PM
import qualified GHC.Exts as Exts

-- | Count the number of times the byte appears in the sequence.
count :: Word8 -> Bytes -> Int
count :: Word8 -> Bytes -> Int
count !Word8
b (Bytes {$sel:array:Bytes :: Bytes -> ByteArray
array = ByteArray ByteArray#
arr, Int
offset :: Int
$sel:offset:Bytes :: Bytes -> Int
offset, Int
length :: Int
$sel:length:Bytes :: Bytes -> Int
length}) =
  ByteArray# -> Int -> Int -> Word8 -> Int
count_ba ByteArray#
arr Int
offset Int
length Word8
b

{- | Variant of 'split' that returns an array of unsliced byte sequences.
Unlike 'split', this is not a good producer for list fusion. (It does
not return a list, so it could not be.) Prefer 'split' if the result
is going to be consumed exactly once by a good consumer. Prefer 'splitU'
if the result of the split is going to be around for a while and
inspected multiple times.
-}
splitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitU !Word8
w !Bytes
bs =
  let !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
      !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens
   in PrimArray Int -> Int -> Bytes -> UnliftedArray ByteArray
splitCommonU PrimArray Int
lens Int
lensSz Bytes
bs

{- | Variant of 'splitU' that drops the trailing element. See 'splitInit'
for an explanation of why this may be useful.
-}
splitInitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitInitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitInitU !Word8
w !Bytes
bs =
  let !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
      !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens
   in PrimArray Int -> Int -> Bytes -> UnliftedArray ByteArray
splitCommonU PrimArray Int
lens (Int
lensSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bytes
bs

-- Internal function
splitCommonU ::
  PrimArray Int -> -- array of segment lengths
  Int -> -- number of lengths to consider
  Bytes ->
  UnliftedArray ByteArray
splitCommonU :: PrimArray Int -> Int -> Bytes -> UnliftedArray ByteArray
splitCommonU !PrimArray Int
lens !Int
lensSz Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
arrIx0} = (forall s. ST s (UnliftedArray_ ByteArray# ByteArray))
-> UnliftedArray_ ByteArray# ByteArray
forall a. (forall s. ST s a) -> a
runST do
  MutableUnliftedArray_ ByteArray# (PrimState (ST s)) ByteArray
dst <- Int -> ST s (MutableUnliftedArray (PrimState (ST s)) ByteArray)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
PM.unsafeNewUnliftedArray Int
lensSz
  let go :: Int -> Int -> ST s ()
go !Int
lenIx !Int
arrIx =
        if Int
lenIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lensSz
          then do
            let !len :: Int
len = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
lenIx
            MutableByteArray (PrimState (ST s))
buf <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
len
            MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray (PrimState (ST s))
buf Int
0 ByteArray
array Int
arrIx Int
len
            ByteArray
buf' <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray (PrimState (ST s))
buf
            MutableUnliftedArray (PrimState (ST s)) ByteArray
-> Int -> ByteArray -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
PM.writeUnliftedArray MutableUnliftedArray_ ByteArray# (PrimState (ST s)) ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
dst Int
lenIx ByteArray
buf'
            Int -> Int -> ST s ()
go (Int
lenIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
arrIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Int -> Int -> ST s ()
go Int
0 Int
arrIx0
  MutableUnliftedArray (PrimState (ST s)) ByteArray
-> ST s (UnliftedArray ByteArray)
forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
PM.unsafeFreezeUnliftedArray MutableUnliftedArray_ ByteArray# (PrimState (ST s)) ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
dst

{- | Break a byte sequence into pieces separated by the byte argument,
consuming the delimiter. This function is a good producer for list
fusion. It is common to immidiately consume the results of @split@
with @foldl'@, @traverse_@, @foldlM@, and being a good producer helps
in this situation.

Note: this function differs from its counterpart in @bytestring@.
If the byte sequence is empty, this returns a singleton list with
the empty byte sequence.
-}
split :: Word8 -> Bytes -> [Bytes]
{-# INLINE split #-}
split :: Word8 -> Bytes -> [Bytes]
split !Word8
w !bs :: Bytes
bs@Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
arrIx0} =
  (forall b. (Bytes -> b -> b) -> b -> b) -> [Bytes]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build
    ( \Bytes -> b -> b
g b
x0 ->
        let go :: Int -> Int -> b
go !Int
lenIx !Int
arrIx =
              if Int
lenIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lensSz
                then
                  let !len :: Int
len = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
lenIx
                   in Bytes -> b -> b
g (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
array Int
arrIx Int
len) (Int -> Int -> b
go (Int
lenIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
arrIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                else b
x0
         in Int -> Int -> b
go Int
0 Int
arrIx0
    )
 where
  !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
  !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens

{- | Variant of 'split' that intended for use with stream fusion rather
than @build@-@foldr@ fusion.
-}
splitStream :: forall m. (Applicative m) => Word8 -> Bytes -> Stream m Bytes
{-# INLINE [1] splitStream #-}
splitStream :: forall (m :: * -> *).
Applicative m =>
Word8 -> Bytes -> Stream m Bytes
splitStream !Word8
w !bs :: Bytes
bs@Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
arrIx0} = (IntPair -> m (Step IntPair Bytes)) -> IntPair -> Stream m Bytes
forall (m :: * -> *) a s. (s -> m (Step s a)) -> s -> Stream m a
Stream IntPair -> m (Step IntPair Bytes)
step (Int -> Int -> IntPair
IntPair Int
0 Int
arrIx0)
 where
  !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
  !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens
  {-# INLINE [0] step #-}
  step :: IntPair -> m (Step IntPair Bytes)
  step :: IntPair -> m (Step IntPair Bytes)
step (IntPair Int
lenIx Int
arrIx) =
    if Int
lenIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lensSz
      then do
        let !len :: Int
len = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
lenIx
            !element :: Bytes
element = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
array Int
arrIx Int
len
            !acc :: IntPair
acc = Int -> Int -> IntPair
IntPair (Int
lenIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
arrIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Step IntPair Bytes -> m (Step IntPair Bytes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IntPair -> Step IntPair Bytes
forall a s. a -> s -> Step s a
Yield Bytes
element IntPair
acc)
      else Step IntPair Bytes -> m (Step IntPair Bytes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step IntPair Bytes
forall s a. Step s a
Done

{- | Variant of 'split' that returns the result as a 'NonEmpty'
instead of @[]@. This is also eligible for stream fusion.
-}
splitNonEmpty :: Word8 -> Bytes -> NonEmpty Bytes
{-# INLINE splitNonEmpty #-}
splitNonEmpty :: Word8 -> Bytes -> NonEmpty Bytes
splitNonEmpty !Word8
w !bs :: Bytes
bs@Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
arrIx0} =
  ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
array Int
arrIx0 Int
len0
    Bytes -> [Bytes] -> NonEmpty Bytes
forall a. a -> [a] -> NonEmpty a
:| (forall b. (Bytes -> b -> b) -> b -> b) -> [Bytes]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build
      ( \Bytes -> b -> b
g b
x0 ->
          let go :: Int -> Int -> b
go !Int
lenIx !Int
arrIx =
                if Int
lenIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lensSz
                  then
                    let !len :: Int
len = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
lenIx
                     in Bytes -> b -> b
g (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
array Int
arrIx Int
len) (Int -> Int -> b
go (Int
lenIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
arrIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                  else b
x0
           in Int -> Int -> b
go Int
1 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
arrIx0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len0))
      )
 where
  !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
  !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens
  !len0 :: Int
len0 = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
0 :: Int

{- | Variant of 'split' that drops the trailing element. This behaves
correctly even if the byte sequence is empty. This is a good producer
for list fusion. This is useful when splitting a text file
into lines.
<https://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_392 POSIX>
mandates that text files end with a newline, so the list resulting
from 'split' always has an empty byte sequence as its last element.
With 'splitInit', that unwanted element is discarded.
-}
splitInit :: Word8 -> Bytes -> [Bytes]
{-# INLINE splitInit #-}
splitInit :: Word8 -> Bytes -> [Bytes]
splitInit !Word8
w !bs :: Bytes
bs@Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
arrIx0} =
  (forall b. (Bytes -> b -> b) -> b -> b) -> [Bytes]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build
    ( \Bytes -> b -> b
g b
x0 ->
        let go :: Int -> Int -> b
go !Int
lenIx !Int
arrIx =
              if Int
lenIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lensSz
                then
                  let !len :: Int
len = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
PM.indexPrimArray PrimArray Int
lens Int
lenIx
                   in Bytes -> b -> b
g (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
array Int
arrIx Int
len) (Int -> Int -> b
go (Int
lenIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
arrIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                else b
x0
         in Int -> Int -> b
go Int
0 Int
arrIx0
    )
 where
  -- Remember, the resulting array from splitLengthsAlt always has
  -- a length of at least one.
  !lens :: PrimArray Int
lens = Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
w Bytes
bs
  !lensSz :: Int
lensSz = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
PM.sizeofPrimArray PrimArray Int
lens Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- Internal function. This is just like splitLengths except that
-- it does not treat the empty byte sequences specially. The result
-- for that byte sequence is a singleton array with the element zero.
splitLengthsAlt :: Word8 -> Bytes -> PrimArray Int
splitLengthsAlt :: Word8 -> Bytes -> PrimArray Int
splitLengthsAlt Word8
b Bytes {$sel:array:Bytes :: Bytes -> ByteArray
array = ByteArray ByteArray#
arr#, $sel:offset:Bytes :: Bytes -> Int
offset = Int
off, $sel:length:Bytes :: Bytes -> Int
length = Int
len} = (forall s. ST s (PrimArray Int)) -> PrimArray Int
forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST do
  let !n :: Int
n = ByteArray# -> Int -> Int -> Word8 -> Int
count_ba ByteArray#
arr# Int
off Int
len Word8
b
  dst :: MutablePrimArray s Int
dst@(MutablePrimArray MutableByteArray# s
dst#) :: MutablePrimArray s Int <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PM.newPrimArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int
total <- IO Int -> ST s Int
forall a s. IO a -> ST s a
unsafeIOToST (ByteArray#
-> Int -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int
forall s.
ByteArray#
-> Int -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int
memchr_ba_many ByteArray#
arr# Int
off Int
len MutableByteArray# s
dst# Int
n Word8
b)
  MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dst Int
n (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
total)
  MutablePrimArray (PrimState (ST s)) Int -> ST s (PrimArray Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PM.unsafeFreezePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
dst

foreign import ccall unsafe "bs_custom.h memchr_ba_many"
  memchr_ba_many ::
    ByteArray# -> Int -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int

foreign import ccall unsafe "bs_custom.h count_ba"
  count_ba ::
    ByteArray# -> Int -> Int -> Word8 -> Int

{- | Split a byte sequence on the first occurrence of the target
byte. The target is removed from the result. For example:

>>> split1 0xA [0x1,0x2,0xA,0xB]
Just ([0x1,0x2],[0xB])
-}
split1 :: Word8 -> Bytes -> Maybe (Bytes, Bytes)
{-# INLINE split1 #-}
split1 :: Word8 -> Bytes -> Maybe (Bytes, Bytes)
split1 Word8
w b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w Bytes
b of
  (Int#
-1#) -> Maybe (Bytes, Bytes)
forall a. Maybe a
Nothing
  Int#
i# ->
    let i :: Int
i = Int# -> Int
I# Int#
i#
     in (Bytes, Bytes) -> Maybe (Bytes, Bytes)
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off), ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)))

{- | Split a byte sequence on the first and second occurrences
of the target byte. The target is removed from the result.
For example:

>>> split2 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]
Just ([0x1,0x2],[0xB],[0xA,0xA])
-}
split2 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes)
{-# INLINE split2 #-}
split2 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes)
split2 Word8
w b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w Bytes
b of
  (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
  Int#
i# ->
    let i :: Int
i = Int# -> Int
I# Int#
i#
     in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
          (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
          Int#
j# ->
            let j :: Int
j = Int# -> Int
I# Int#
j#
             in (Bytes, Bytes, Bytes) -> Maybe (Bytes, Bytes, Bytes)
forall a. a -> Maybe a
Just
                  ( ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)
                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
j 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))
                  )

{- | Split a byte sequence on the first, second, and third occurrences
of the target byte. The target is removed from the result.
For example:

>>> split3 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]
Just ([0x1,0x2],[0xB],[],[0xA])
-}
split3 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes, Bytes)
{-# INLINE split3 #-}
split3 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes, Bytes)
split3 Word8
w b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w Bytes
b of
  (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
  Int#
i# ->
    let i :: Int
i = Int# -> Int
I# Int#
i#
     in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
          (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
          Int#
j# ->
            let j :: Int
j = Int# -> Int
I# Int#
j#
             in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
j 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
                  (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
                  Int#
k# ->
                    let k :: Int
k = Int# -> Int
I# Int#
k#
                     in (Bytes, Bytes, Bytes, Bytes) -> Maybe (Bytes, Bytes, Bytes, Bytes)
forall a. a -> Maybe a
Just
                          ( ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)
                          , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                          , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                          , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
k 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))
                          )

{- | Split a byte sequence on the first, second, third, and fourth
occurrences of the target byte. The target is removed from the result.
For example:

>>> split4 0xA [0x1,0x2,0xA,0xB,0xA,0xA,0xA]
Just ([0x1,0x2],[0xB],[],[],[])
-}
split4 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
{-# INLINE split4 #-}
split4 :: Word8 -> Bytes -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
split4 Word8
w b :: Bytes
b@(Bytes ByteArray
arr Int
off Int
len) = case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w Bytes
b of
  (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
  Int#
i# ->
    let i :: Int
i = Int# -> Int
I# Int#
i#
     in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
          (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
          Int#
j# ->
            let j :: Int
j = Int# -> Int
I# Int#
j#
             in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
j 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
                  (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
                  Int#
k# ->
                    let k :: Int
k = Int# -> Int
I# Int#
k#
                     in case Word8 -> Bytes -> Int#
elemIndexLoop# Word8
w (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
k 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))) of
                          (Int#
-1#) -> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
forall a. Maybe a
Nothing
                          Int#
m# ->
                            let m :: Int
m = Int# -> Int
I# Int#
m#
                             in (Bytes, Bytes, Bytes, Bytes, Bytes)
-> Maybe (Bytes, Bytes, Bytes, Bytes, Bytes)
forall a. a -> Maybe a
Just
                                  ( ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)
                                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                                  , ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
m 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off))
                                  )

-- This returns the offset into the byte array. This is not an index
-- that will mean anything to the end user, so it cannot be returned
-- to them.
--
-- Exported for use in other internal modules because it is needed in
-- Data.Bytes.Search.
elemIndexLoop# :: Word8 -> Bytes -> Int#
{-# INLINE elemIndexLoop# #-}
elemIndexLoop# :: Word8 -> Bytes -> Int#
elemIndexLoop# !Word8
w (Bytes ByteArray
arr off :: Int
off@(I# Int#
off#) Int
len) = case Int
len of
  Int
0 -> (Int#
-1#)
  Int
_ ->
    if ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
off Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w
      then Int#
off#
      else Word8 -> Bytes -> Int#
elemIndexLoop# Word8
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))

-- Variant of elemIndexLoop# that starts at the end. Similarly, returns
-- negative one if the element is not found.
elemIndexLoopBackwards# :: Word8 -> ByteArray -> Int -> Int -> Int#
elemIndexLoopBackwards# :: Word8 -> ByteArray -> Int -> Int -> Int#
elemIndexLoopBackwards# !Word8
w !ByteArray
arr !Int
start !pos :: Int
pos@(I# Int#
pos#) =
  if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start
    then (Int#
-1#)
    else
      if ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
arr Int
pos Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w
        then Int#
pos#
        else Word8 -> ByteArray -> Int -> Int -> Int#
elemIndexLoopBackwards# Word8
w ByteArray
arr Int
start (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

{- | Split a byte sequence on the last occurrence of the target
byte. The target is removed from the result. For example:

>>> split1 0xA [0x1,0x2,0xA,0xB,0xA,0xC]
Just ([0x1,0x2,0xA,0xB],[0xC])
-}
splitEnd1 :: Word8 -> Bytes -> Maybe (Bytes, Bytes)
{-# INLINE splitEnd1 #-}
splitEnd1 :: Word8 -> Bytes -> Maybe (Bytes, Bytes)
splitEnd1 !Word8
w (Bytes ByteArray
arr Int
off Int
len) = case Word8 -> ByteArray -> Int -> Int -> Int#
elemIndexLoopBackwards# Word8
w ByteArray
arr Int
off (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) of
  (Int#
-1#) -> Maybe (Bytes, Bytes)
forall a. Maybe a
Nothing
  Int#
i# ->
    let i :: Int
i = Int# -> Int
I# Int#
i#
     in (Bytes, Bytes) -> Maybe (Bytes, Bytes)
forall a. a -> Maybe a
Just (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off), ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr (Int
i 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)))