-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
--              (c) 2023 Pierre Le Marre
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Low-level routines for 'Buffer' manipulations.
module Data.Text.Builder.Linear.Core (
  -- * Type
  Buffer,

  -- * Basic interface
  runBuffer,
  runBufferBS,
  dupBuffer,
  consumeBuffer,
  eraseBuffer,
  byteSizeOfBuffer,
  lengthOfBuffer,
  dropBuffer,
  takeBuffer,
  newEmptyBuffer,

  -- * Text concatenation
  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#, plusAddr#, unsafeCoerce#)
import GHC.ForeignPtr (ForeignPtr (..), ForeignPtrContents (..))
import GHC.ST (ST (..), runST)

import Data.Text.Builder.Linear.Array

-- | 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)))
{-# NOINLINE runBuffer #-}

{-
  See https://github.com/Bodigrim/linear-builder/issues/19
  and https://github.com/tweag/linear-base/pull/187#discussion_r489081926
  for the discussion why NOINLINE here and below in 'runBufferBS' is necessary.
  Without it CSE (common subexpression elimination) can pull out 'Buffer's from
  different 'runBuffer's and share them, which is absolutely not what we want.
-}

-- | 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))
{-# NOINLINE runBufferBS #-}

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

-- | Create an empty 'Buffer'.
--
-- The first 'Buffer' is the input and the second is a new empty 'Buffer'.
--
-- This function is needed in some situations, e.g. with
-- 'Data.Text.Builder.Linear.Buffer.justifyRight'. The following example creates
-- a utility function that justify a text and then append it to a buffer.
--
-- >>> :set -XOverloadedStrings -XLinearTypes -XUnboxedTuples
-- >>> import Data.Text.Builder.Linear.Buffer
-- >>> import Data.Text (Text)
-- >>> :{
-- appendJustified :: Buffer %1 -> Text -> Buffer
-- appendJustified b t = case newEmptyBuffer b of
--   -- Note that we need to create a new buffer from the text, in order
--   -- to justify only the text and not the input buffer.
--   (# b', empty #) -> b' >< justifyRight 12 ' ' (empty |> t)
-- :}
--
-- >>> runBuffer (\b -> (b |> "Test:") `appendJustified` "foo" `appendJustified` "bar")
-- "Test:         foo         bar"
--
-- Note: a previous buffer is necessary in order to create an empty buffer with
-- the same characteristics.
newEmptyBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)
newEmptyBuffer :: Buffer %1 -> (# Buffer, Buffer #)
newEmptyBuffer (Buffer t :: Text
t@(Text ByteArray
arr Int
_ Int
_)) =
  (# Text -> Buffer
Buffer Text
t, Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
arr then Text
memptyPinned else forall a. Monoid a => a
mempty) #)

-- | 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 -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
-- "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 = case lengthOfBuffer buf of
--   (# buf', len #) -> case move len of
--     Ur len' -> takeBuffer (len' - n) 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 known 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 #-}

-- | 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 -> case dupBuffer b of (# b1, b2 #) -> ("foo" <| b1) >< (b2 |> "bar"))
-- "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)