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

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

  -- * Text concatenation
  appendBounded,
  appendExact,
  prependBounded,
  prependBounded',
  appendBounded',
  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 Text
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 ForeignPtr Word8
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 = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
forall a b. a -> b
unsafeCoerce# ByteArray#
arr))
{-# NOINLINE runBufferBS #-}

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

memptyPinned ∷ Text
memptyPinned :: Text
memptyPinned = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
  MArray s
marr ← Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned Int
0
  Array
arr ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
  Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
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` "AAA" `appendJustified` "BBBBBBB")
-- "Test:         AAA     BBBBBBB"
--
-- 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 Array
arr Int
_ Int
_)) =
  (# Text -> Buffer
Buffer Text
t, Text -> Buffer
Buffer (if Array -> Bool
isPinned Array
arr then Text
memptyPinned else Text
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 Array
arr Int
_ Int
_)) =
  Text -> Buffer
Buffer (if Array -> Bool
isPinned Array
arr then Text
memptyPinned else Text
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 Array
_ Int
_ Int
len)) = (# Text -> Buffer
Buffer Text
t, Int -> Word
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, Int -> Word
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 Array
arr Int
off Int
len))
  | Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
0)
  | Bool
otherwise = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nByte) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nByte))
  where
    nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
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 Array
arr Int
off Int
_))
  | Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer Text
t
  | Bool
otherwise = Text -> Buffer
Buffer (Array -> Int -> Int -> Text
Text Array
arr Int
off Int
nByte)
  where
    nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
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 Array
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
  let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
      newFullLen :: Int
newFullLen = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
  MArray s
newM ←
    if Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
      then Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
      else do
        MArray s
tmpM ← (if Array -> Bool
isPinned Array
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
        Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
tmpM Int
dstOff Array
dst Int
dstOff
        MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s
tmpM
  Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
appender MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
  Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
  Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
dstOff (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE appendBounded #-}

-- | Low-level routine to append data of unknown size to a 'Buffer', giving
-- the action the choice between two strategies.
--
-- See also: 'appendBounded'.
--
-- @since 0.1.3
appendBounded'
  ∷ Int
  -- ^ Upper bound for the number of bytes, written by an action
  → (∀ s x. ((A.MArray s → Int → ST s Int) → ST s x) → ((A.MArray s → Int → ST s Int) → ST s x) → ST s x)
  -- ^ Action, which appends bytes using one of the following strategies:
  --
  -- * writes bytes __starting__ from the given offset, using its first argument,
  -- * writes bytes __finishing__ before the given offset, using its second argument.
  --
  -- The function passed to either argument returns the actual number of bytes written.
  → Buffer
  ⊸ Buffer
appendBounded' :: Int
-> (forall s x.
    ((MArray s -> Int -> ST s Int) -> ST s x)
    -> ((MArray s -> Int -> ST s Int) -> ST s x) -> ST s x)
-> Buffer
%1 -> Buffer
appendBounded' Int
maxSrcLen forall s x.
((MArray s -> Int -> ST s Int) -> ST s x)
-> ((MArray s -> Int -> ST s Int) -> ST s x) -> ST s x
writer (Buffer (Text Array
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
  let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
      newFullLen :: Int
newFullLen = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
  MArray s
newM ←
    if Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
      then Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
      else do
        MArray s
tmpM ← (if Array -> Bool
isPinned Array
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
        Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
tmpM Int
dstOff Array
dst Int
dstOff
        MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s
tmpM
  let append :: (MArray s -> Int -> ST s b) -> ST s (Int, b)
append = \MArray s -> Int -> ST s b
appender → do
        b
count ← MArray s -> Int -> ST s b
appender MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
        (Int, b) -> ST s (Int, b)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
dstOff, b
count)
  -- Action that prepends then copies the result to the final destination, if necessary
  let prepend :: (MArray s -> Int -> ST s Int) -> ST s (Int, Int)
prepend = \MArray s -> Int -> ST s Int
prepender → case Int
dstLen of
        Int
0 → do
          -- Buffer is empty: prepend to final destination
          Int
count ← MArray s -> Int -> ST s Int
prepender MArray s
newM Int
maxSrcLen
          (Int, Int) -> ST s (Int, Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
maxSrcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count, Int
count)
        Int
_ → do
          -- Require extra buffer + copy to final destination
          let off' :: Int
off'
                -- Reuse space before current data (no overlap)
                | Int
dstOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxSrcLen = Int
dstOff
                -- Reuse space after current data (overlap)
                | Bool
otherwise = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen
          Int
count ← MArray s -> Int -> ST s Int
prepender MArray s
newM Int
off'
          -- Note: we rely on copyM allowing overlaps
          MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen) MArray s
newM (Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count) Int
count
          (Int, Int) -> ST s (Int, Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
dstOff, Int
count)
  !(Int
dstOff', Int
srcLen) ← ((MArray s -> Int -> ST s Int) -> ST s (Int, Int))
-> ((MArray s -> Int -> ST s Int) -> ST s (Int, Int))
-> ST s (Int, Int)
forall s x.
((MArray s -> Int -> ST s Int) -> ST s x)
-> ((MArray s -> Int -> ST s Int) -> ST s x) -> ST s x
writer (MArray s -> Int -> ST s Int) -> ST s (Int, Int)
forall {b}. (MArray s -> Int -> ST s b) -> ST s (Int, b)
append (MArray s -> Int -> ST s Int) -> ST s (Int, Int)
prepend
  Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
  Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
dstOff' (Int
dstLen Int -> Int -> Int
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 → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
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 Array
dst Int
dstOff Int
dstLen))
  | Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
      Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
prepender MArray s
newM Int
dstOff
      Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
      Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
  | Bool
otherwise = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
          newOff :: Int
newOff = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen
          newFullLen :: Int
newFullLen = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
newOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dstFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen)
      MArray s
newM ← (if Array -> Bool
isPinned Array
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
      Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
appender MArray s
newM Int
newOff
      Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
newM (Int
newOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen) Array
dst Int
dstOff
      Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
      Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
newOff (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
{-# INLINE prependBounded #-}

-- | Low-level routine to prepend data of unknown size to a 'Buffer'.
--
-- Contrary to 'prependBounded', only use a prepend action.
--
-- @since 0.1.3
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.
  → Buffer
  ⊸ Buffer
prependBounded' :: Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
prependBounded' Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
prepender (Buffer (Text Array
dst Int
dstOff Int
dstLen))
  | Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
dst
      Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
prepender MArray s
newM Int
dstOff
      Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
      Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) (Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
  | Bool
otherwise = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
      let dstFullLen :: Int
dstFullLen = Array -> Int
sizeofByteArray Array
dst
          off :: Int
off = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxSrcLen
          newFullLen :: Int
newFullLen = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dstFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff)
      MArray s
newM ← (if Array -> Bool
isPinned Array
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
      Int
srcLen ← MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
prepender MArray s
newM Int
off
      Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
dstLen MArray s
newM Int
off Array
dst Int
dstOff
      Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
      Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) (Int
dstLen Int -> Int -> Int
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 → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
    (\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
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 Array
left Int
leftOff Int
leftLen) >< :: Buffer %1 -> Buffer %1 -> Buffer
>< Buffer (Text Array
right Int
rightOff Int
rightLen) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
  let leftFullLen :: Int
leftFullLen = Array -> Int
sizeofByteArray Array
left
      rightFullLen :: Int
rightFullLen = Array -> Int
sizeofByteArray Array
right
      canCopyToLeft :: Bool
canCopyToLeft = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
leftFullLen
      canCopyToRight :: Bool
canCopyToRight = Int
leftLen Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rightLen)
  if Bool
shouldCopyToLeft
    then do
      MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
left
      Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) Array
right Int
rightOff
      Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
      Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
leftOff (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
    else
      if Bool
canCopyToRight
        then do
          MArray s
newM ← Array -> ST s (MArray s)
forall s. Array -> ST s (MArray s)
unsafeThaw Array
right
          Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM (Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLen) Array
left Int
leftOff
          Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
          Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new (Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLen) (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
        else do
          let fullLen :: Int
fullLen = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
rightFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightLen)
          MArray s
newM ← (if Array -> Bool
isPinned Array
left Bool -> Bool -> Bool
|| Array -> Bool
isPinned Array
right then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
fullLen
          Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
leftLen MArray s
newM Int
leftOff Array
left Int
leftOff
          Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
rightLen MArray s
newM (Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) Array
right Int
rightOff
          Array
new ← MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
newM
          Text -> ST s Text
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
new Int
leftOff (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)