-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Low-level routines for 'Buffer' manipulations.
module Data.Text.Builder.Linear.Core (
  Buffer,
  runBuffer,
  runBufferBS,
  dupBuffer,
  consumeBuffer,
  eraseBuffer,
  byteSizeOfBuffer,
  lengthOfBuffer,
  dropBuffer,
  takeBuffer,
  appendBounded,
  appendExact,
  prependBounded,
  prependExact,
  (><),
) where

import Data.ByteString.Internal (ByteString (..))
import Data.Text qualified as T
import Data.Text.Array qualified as A
import Data.Text.Internal (Text (..))
import GHC.Exts (Int (..), Levity (..), RuntimeRep (..), TYPE, byteArrayContents#, isByteArrayPinned#, isTrue#, plusAddr#, sizeofByteArray#, unsafeCoerce#)
import GHC.ForeignPtr (ForeignPtr (..), ForeignPtrContents (..))
import GHC.ST (ST (..), runST)

-- | Internally 'Buffer' is a mutable buffer.
-- If a client gets hold of a variable of type 'Buffer',
-- they'd be able to pass a mutable buffer to concurrent threads.
-- That's why API below is carefully designed to prevent such possibility:
-- clients always work with linear functions 'Buffer' ⊸ 'Buffer' instead
-- and run them on an empty 'Buffer' to extract results.
--
-- In terms of [@linear-base@](https://hackage.haskell.org/package/linear-base)
-- 'Buffer' is [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)
-- (see 'consumeBuffer')
-- and [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)
-- (see 'dupBuffer'),
-- but not [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable).
--
-- >>> :set -XOverloadedStrings -XLinearTypes
-- >>> import Data.Text.Builder.Linear.Buffer
-- >>> runBuffer (\b -> '!' .<| "foo" <| (b |> "bar" |>. '.'))
-- "!foobar."
--
-- Remember: this is a strict builder, so on contrary to "Data.Text.Lazy.Builder"
-- for optimal performance you should use strict left folds instead of lazy right ones.
--
-- 'Buffer' is an unlifted datatype,
-- so you can put it into an unboxed tuple @(# ..., ... #)@,
-- but not into @(..., ...)@.
data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where
  Buffer ∷ {-# UNPACK #-} !Text → Buffer

-- | Unwrap 'Buffer', no-op.
-- Most likely, this is not the function you're looking for
-- and you need 'runBuffer' instead.
unBuffer ∷ Buffer ⊸ Text
unBuffer :: Buffer %1 -> Text
unBuffer (Buffer Text
x) = Text
x

-- | Run a linear function on an empty 'Buffer', producing a strict 'Text'.
--
-- Be careful to write @runBuffer (\b -> ...)@ instead of @runBuffer $ \b -> ...@,
-- because current implementation of linear types lacks special support for '($)'.
-- Another option is to enable @{-# LANGUAGE BlockArguments #-}@
-- and write @runBuffer \b -> ...@.
-- Alternatively, you can import
-- [@($)@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#v:-36-)
-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).
--
-- 'runBuffer' is similar in spirit to mutable arrays API in
-- [@Data.Array.Mutable.Linear@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html),
-- which provides functions like
-- [@fromList@](https://hackage.haskell.org/package/linear-base/docs/Data-Array-Mutable-Linear.html#v:fromList) ∷ [@a@] → (@Vector@ @a@ ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) b) ⊸ [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) @b@.
-- Here the initial buffer is always empty and @b@ is 'Text'. Since 'Text' is
-- [@Movable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Movable),
-- 'Text' and [@Ur@](https://hackage.haskell.org/package/linear-base-0.3.0/docs/Prelude-Linear.html#t:Ur) 'Text' are equivalent.
runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text
runBuffer :: (Buffer %1 -> Buffer) %1 -> Text
runBuffer Buffer %1 -> Buffer
f = Buffer %1 -> Text
unBuffer (Buffer %1 -> Buffer
shrinkBuffer (Buffer %1 -> Buffer
f (Text -> Buffer
Buffer forall a. Monoid a => a
mempty)))

-- | Same as 'runBuffer', but returning a UTF-8 encoded strict 'ByteString'.
runBufferBS ∷ (Buffer ⊸ Buffer) ⊸ ByteString
runBufferBS :: (Buffer %1 -> Buffer) %1 -> ByteString
runBufferBS Buffer %1 -> Buffer
f = case Buffer %1 -> Buffer
shrinkBuffer (Buffer %1 -> Buffer
f (Text -> Buffer
Buffer Text
memptyPinned)) of
  Buffer (Text (A.ByteArray ByteArray#
arr) (I# Int#
from) Int
len) → ForeignPtr Word8 -> Int -> ByteString
BS forall {a}. ForeignPtr a
fp Int
len
    where
      addr# :: Addr#
addr# = ByteArray# -> Addr#
byteArrayContents# ByteArray#
arr Addr# -> Int# -> Addr#
`plusAddr#` Int#
from
      fp :: ForeignPtr a
fp = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
arr))

shrinkBuffer ∷ Buffer ⊸ Buffer
shrinkBuffer :: Buffer %1 -> Buffer
shrinkBuffer (Buffer (Text ByteArray
arr Int
from Int
len)) = Text -> Buffer
Buffer forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MArray s
arrM ← forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
arr
  forall s. MArray s -> Int -> ST s ()
A.shrinkM MArray s
arrM (Int
from forall a. Num a => a -> a -> a
+ Int
len)
  ByteArray
arr' ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
arrM
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
arr' Int
from Int
len

memptyPinned ∷ Text
memptyPinned :: Text
memptyPinned = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MArray s
marr ← forall s. Int -> ST s (MArray s)
A.newPinned Int
0
  ByteArray
arr ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
marr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
arr Int
0 Int
0

-- | Duplicate builder. Feel free to process results in parallel threads.
-- Similar to
-- [@Dupable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Dupable)
-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).
--
-- It is a bit tricky to use because of
-- <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/linear_types.html#limitations current limitations>
-- of linear types with regards to @let@ and @where@. E. g., one cannot write
--
-- > let (# b1, b2 #) = dupBuffer b in ("foo" <| b1) >< (b2 |> "bar")
--
-- Instead write:
--
-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples
-- >>> import Data.Text.Builder.Linear.Buffer
-- >>> runBuffer (\b -> (\(# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar")) (dupBuffer b))
-- "foobar"
--
-- Note the unboxed tuple: 'Buffer' is an unlifted datatype,
-- so it cannot be put into @(..., ...)@.
dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)
dupBuffer :: Buffer %1 -> (# Buffer, Buffer #)
dupBuffer (Buffer Text
x) = (# Text -> Buffer
Buffer Text
x, Text -> Buffer
Buffer (Text -> Text
T.copy Text
x) #)

-- | Consume buffer linearly,
-- similar to
-- [@Consumable@](https://hackage.haskell.org/package/linear-base/docs/Prelude-Linear.html#t:Consumable)
-- from [@linear-base@](https://hackage.haskell.org/package/linear-base).
consumeBuffer ∷ Buffer ⊸ ()
consumeBuffer :: Buffer %1 -> ()
consumeBuffer Buffer {} = ()

-- | Erase buffer's content, replacing it with an empty 'Text'.
eraseBuffer ∷ Buffer ⊸ Buffer
eraseBuffer :: Buffer %1 -> Buffer
eraseBuffer (Buffer (Text ByteArray
arr Int
_ Int
_)) =
  Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
arr then Text
memptyPinned else forall a. Monoid a => a
mempty)

-- | Return buffer's size in __bytes__ (not in 'Char's).
-- This could be useful to implement a lazy builder atop of a strict one.
byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
byteSizeOfBuffer :: Buffer %1 -> (# Buffer, Word #)
byteSizeOfBuffer (Buffer t :: Text
t@(Text ByteArray
_ Int
_ Int
len)) = (# Text -> Buffer
Buffer Text
t, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len #)

-- | Return buffer's length in 'Char's (not in bytes).
-- This could be useful to implement @dropEndBuffer@ and @takeEndBuffer@, e. g.,
--
-- @
-- import Data.Unrestricted.Linear
--
-- dropEndBuffer :: Word -> Buffer %1 -> Buffer
-- dropEndBuffer n buf =
--   (\(# buf', len #) -> case move len of Ur len' -> takeBuffer (len' - n) buf')
--     (lengthOfBuffer buf)
-- @
lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
lengthOfBuffer :: Buffer %1 -> (# Buffer, Word #)
lengthOfBuffer (Buffer Text
t) = (# Text -> Buffer
Buffer Text
t, forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t) #)

-- | Slice 'Buffer' by dropping given number of 'Char's.
dropBuffer ∷ Word → Buffer ⊸ Buffer
dropBuffer :: Word -> Buffer %1 -> Buffer
dropBuffer Word
nChar (Buffer t :: Text
t@(Text ByteArray
arr Int
off Int
len))
  | Int
nByte forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr (Int
off forall a. Num a => a -> a -> a
+ Int
len) Int
0)
  | Bool
otherwise = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr (Int
off forall a. Num a => a -> a -> a
+ Int
nByte) (Int
len forall a. Num a => a -> a -> a
- Int
nByte))
  where
    nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t

-- | Slice 'Buffer' by taking given number of 'Char's.
takeBuffer ∷ Word → Buffer ⊸ Buffer
takeBuffer :: Word -> Buffer %1 -> Buffer
takeBuffer Word
nChar (Buffer t :: Text
t@(Text ByteArray
arr Int
off Int
_))
  | Int
nByte forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer Text
t
  | Bool
otherwise = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr Int
off Int
nByte)
  where
    nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t

-- | Low-level routine to append data of unknown size to a 'Buffer'.
appendBounded
  ∷ Int
  -- ^ Upper bound for the number of bytes, written by an action
  → (∀ s. A.MArray s → Int → ST s Int)
  -- ^ Action, which writes bytes __starting__ from the given offset
  -- and returns an actual number of bytes written.
  → Buffer
  ⊸ Buffer
appendBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
      newFullLen :: Int
newFullLen = Int
dstOff forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* (Int
dstLen forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
  MArray s
newM ←
    if Int
dstOff forall a. Num a => a -> a -> a
+ Int
dstLen forall a. Num a => a -> a -> a
+ Int
maxSrcLen forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
      then forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      else do
        MArray s
tmpM ← (if ByteArray -> Bool
isPinned ByteArray
dst then forall s. Int -> ST s (MArray s)
A.newPinned else forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
        forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
dstLen MArray s
tmpM Int
dstOff ByteArray
dst Int
dstOff
        forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s
tmpM
  Int
srcLen ← forall s. MArray s -> Int -> ST s Int
appender MArray s
newM (Int
dstOff forall a. Num a => a -> a -> a
+ Int
dstLen)
  ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new Int
dstOff (Int
dstLen forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE appendBounded #-}

-- | Low-level routine to append data of known size to a 'Buffer'.
appendExact
  ∷ Int
  -- ^ Exact number of bytes, written by an action
  → (∀ s. A.MArray s → Int → ST s ())
  -- ^ Action, which writes bytes __starting__ from the given offset
  → Buffer
  ⊸ Buffer
appendExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
appendExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender =
  Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
    Int
srcLen
    (\MArray s
dst Int
dstOff → forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE appendExact #-}

-- | Low-level routine to prepend data of unknown size to a 'Buffer'.
prependBounded
  ∷ Int
  -- ^ Upper bound for the number of bytes, written by an action
  → (∀ s. A.MArray s → Int → ST s Int)
  -- ^ Action, which writes bytes __finishing__ before the given offset
  -- and returns an actual number of bytes written.
  → (∀ s. A.MArray s → Int → ST s Int)
  -- ^ Action, which writes bytes __starting__ from the given offset
  -- and returns an actual number of bytes written.
  → Buffer
  ⊸ Buffer
prependBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
prepender forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen))
  | Int
maxSrcLen forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      MArray s
newM ← forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      Int
srcLen ← forall s. MArray s -> Int -> ST s Int
prepender MArray s
newM Int
dstOff
      ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new (Int
dstOff forall a. Num a => a -> a -> a
- Int
srcLen) (Int
srcLen forall a. Num a => a -> a -> a
+ Int
dstLen)
  | Bool
otherwise = Text -> Buffer
Buffer forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
          newOff :: Int
newOff = Int
dstLen forall a. Num a => a -> a -> a
+ Int
maxSrcLen
          newFullLen :: Int
newFullLen = Int
2 forall a. Num a => a -> a -> a
* Int
newOff forall a. Num a => a -> a -> a
+ (Int
dstFullLen forall a. Num a => a -> a -> a
- Int
dstOff forall a. Num a => a -> a -> a
- Int
dstLen)
      MArray s
newM ← (if ByteArray -> Bool
isPinned ByteArray
dst then forall s. Int -> ST s (MArray s)
A.newPinned else forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
      Int
srcLen ← forall s. MArray s -> Int -> ST s Int
appender MArray s
newM Int
newOff
      forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
dstLen MArray s
newM (Int
newOff forall a. Num a => a -> a -> a
+ Int
srcLen) ByteArray
dst Int
dstOff
      ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new Int
newOff (Int
dstLen forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE prependBounded #-}

-- | Low-level routine to append data of unknown size to a 'Buffer'.
prependExact
  ∷ Int
  -- ^ Exact number of bytes, written by an action
  → (∀ s. A.MArray s → Int → ST s ())
  -- ^ Action, which writes bytes __starting__ from the given offset
  → Buffer
  ⊸ Buffer
prependExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
prependExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender =
  Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
    Int
srcLen
    (\MArray s
dst Int
dstOff → forall s. MArray s -> Int -> ST s ()
appender MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
- Int
srcLen) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
    (\MArray s
dst Int
dstOff → forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE prependExact #-}

unsafeThaw ∷ A.Array → ST s (A.MArray s)
unsafeThaw :: forall s. ByteArray -> ST s (MArray s)
unsafeThaw (A.ByteArray ByteArray#
a) = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s# →
  (# State# s
s#, forall s. MutableByteArray# s -> MutableByteArray s
A.MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ByteArray#
a) #)

sizeofByteArray ∷ A.Array → Int
sizeofByteArray :: ByteArray -> Int
sizeofByteArray (A.ByteArray ByteArray#
a) = Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
a)

isPinned ∷ A.Array → Bool
isPinned :: ByteArray -> Bool
isPinned (A.ByteArray ByteArray#
a) = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
a)

-- | Concatenate two 'Buffer's, potentially mutating both of them.
--
-- You likely need to use 'dupBuffer' to get hold on two builders at once:
--
-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples
-- >>> import Data.Text.Builder.Linear.Buffer
-- >>> runBuffer (\b -> (\(# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar")) (dupBuffer b))
-- "foobar"
(><) ∷ Buffer ⊸ Buffer ⊸ Buffer

infix 6 ><
Buffer (Text ByteArray
left Int
leftOff Int
leftLen) >< :: Buffer %1 -> Buffer %1 -> Buffer
>< Buffer (Text ByteArray
right Int
rightOff Int
rightLen) = Text -> Buffer
Buffer forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let leftFullLen :: Int
leftFullLen = ByteArray -> Int
sizeofByteArray ByteArray
left
      rightFullLen :: Int
rightFullLen = ByteArray -> Int
sizeofByteArray ByteArray
right
      canCopyToLeft :: Bool
canCopyToLeft = Int
leftOff forall a. Num a => a -> a -> a
+ Int
leftLen forall a. Num a => a -> a -> a
+ Int
rightLen forall a. Ord a => a -> a -> Bool
<= Int
leftFullLen
      canCopyToRight :: Bool
canCopyToRight = Int
leftLen forall a. Ord a => a -> a -> Bool
<= Int
rightOff
      shouldCopyToLeft :: Bool
shouldCopyToLeft = Bool
canCopyToLeft Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
canCopyToRight Bool -> Bool -> Bool
|| Int
leftLen forall a. Ord a => a -> a -> Bool
>= Int
rightLen)
  if Bool
shouldCopyToLeft
    then do
      MArray s
newM ← forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
left
      forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff forall a. Num a => a -> a -> a
+ Int
leftLen) ByteArray
right Int
rightOff
      ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new Int
leftOff (Int
leftLen forall a. Num a => a -> a -> a
+ Int
rightLen)
    else
      if Bool
canCopyToRight
        then do
          MArray s
newM ← forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
right
          forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM (Int
rightOff forall a. Num a => a -> a -> a
- Int
leftLen) ByteArray
left Int
leftOff
          ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new (Int
rightOff forall a. Num a => a -> a -> a
- Int
leftLen) (Int
leftLen forall a. Num a => a -> a -> a
+ Int
rightLen)
        else do
          let fullLen :: Int
fullLen = Int
leftOff forall a. Num a => a -> a -> a
+ Int
leftLen forall a. Num a => a -> a -> a
+ Int
rightLen forall a. Num a => a -> a -> a
+ (Int
rightFullLen forall a. Num a => a -> a -> a
- Int
rightOff forall a. Num a => a -> a -> a
- Int
rightLen)
          MArray s
newM ← (if ByteArray -> Bool
isPinned ByteArray
left Bool -> Bool -> Bool
|| ByteArray -> Bool
isPinned ByteArray
right then forall s. Int -> ST s (MArray s)
A.newPinned else forall s. Int -> ST s (MArray s)
A.new) Int
fullLen
          forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM Int
leftOff ByteArray
left Int
leftOff
          forall s. Int -> MArray s -> Int -> ByteArray -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff forall a. Num a => a -> a -> a
+ Int
leftLen) ByteArray
right Int
rightOff
          ByteArray
new ← forall s. MArray s -> ST s ByteArray
A.unsafeFreeze MArray s
newM
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> Text
Text ByteArray
new Int
leftOff (Int
leftLen forall a. Num a => a -> a -> a
+ Int
rightLen)