-- |
-- 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
fp Int
len
    where
      addr# :: Addr#
addr# = ByteArray# -> Addr#
byteArrayContents# ByteArray#
arr Addr# -> Int# -> Addr#
`plusAddr#` Int#
from
      fp :: ForeignPtr Word8
fp = Addr# -> ForeignPtrContents -> ForeignPtr Word8
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 ByteArray
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
  arrM  ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
arr
  A.shrinkM arrM (from + len)
  arr'  A.unsafeFreeze arrM
  pure $ Text arr' from 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
  marr  Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned Int
0
  arr  A.unsafeFreeze marr
  pure $ Text arr 0 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 ByteArray
arr Int
_ Int
_)) =
  (# Text -> Buffer
Buffer Text
t, Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
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 ByteArray
arr Int
_ Int
_)) =
  Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
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 ByteArray
_ 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 ByteArray
arr Int
off Int
len))
  | Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr (Int
off Int -> Int -> Int
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 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 ByteArray
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 (ByteArray -> Int -> Int -> Text
Text ByteArray
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 ByteArray
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 = ByteArray -> Int
sizeofByteArray ByteArray
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)
  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 ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      else do
        tmpM  (if ByteArray -> Bool
isPinned ByteArray
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
        A.copyI dstLen tmpM dstOff dst dstOff
        pure tmpM
  srcLen  appender newM (dstOff + dstLen)
  new  A.unsafeFreeze newM
  pure $ Text new dstOff (dstLen + 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 ByteArray
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 = ByteArray -> Int
sizeofByteArray ByteArray
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)
  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 ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      else do
        tmpM  (if ByteArray -> Bool
isPinned ByteArray
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
        A.copyI dstLen tmpM dstOff dst dstOff
        pure tmpM
  let append = \MArray s -> Int -> ST s Int
appender  do
        count  MArray s -> Int -> ST s Int
appender MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
        pure (dstOff, count)
  -- Action that prepends then copies the result to the final destination, if necessary
  let prepend = \MArray s -> Int -> ST s Int
prepender  case Int
dstLen of
        Int
0  do
          -- Buffer is empty: prepend to final destination
          count  MArray s -> Int -> ST s Int
prepender MArray s
newM Int
maxSrcLen
          pure (maxSrcLen - count, 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
          count  MArray s -> Int -> ST s Int
prepender MArray s
newM Int
off'
          -- Note: we rely on copyM allowing overlaps
          A.copyM newM (dstOff + dstLen) newM (off' - count) count
          pure (dstOff, count)
  !(dstOff', srcLen)  writer append prepend
  new  A.unsafeFreeze newM
  pure $ Text new dstOff' (dstLen + 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 ByteArray
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
      newM  ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      srcLen  prepender newM dstOff
      new  A.unsafeFreeze newM
      pure $ Text new (dstOff - srcLen) (srcLen + 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 = ByteArray -> Int
sizeofByteArray ByteArray
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)
      newM  (if ByteArray -> Bool
isPinned ByteArray
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
      srcLen  appender newM newOff
      A.copyI dstLen newM (newOff + srcLen) dst dstOff
      new  A.unsafeFreeze newM
      pure $ Text new newOff (dstLen + 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 ByteArray
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
      newM  ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
      srcLen  prepender newM dstOff
      new  A.unsafeFreeze newM
      pure $ Text new (dstOff - srcLen) (srcLen + 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 = ByteArray -> Int
sizeofByteArray ByteArray
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)
      newM  (if ByteArray -> Bool
isPinned ByteArray
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
      srcLen  prepender newM off
      A.copyI dstLen newM off dst dstOff
      new  A.unsafeFreeze newM
      pure $ Text new (off - srcLen) (dstLen + 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 ByteArray
left Int
leftOff Int
leftLen) >< :: Buffer %1 -> Buffer %1 -> Buffer
>< Buffer (Text ByteArray
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 = ByteArray -> Int
sizeofByteArray ByteArray
left
      rightFullLen :: Int
rightFullLen = ByteArray -> Int
sizeofByteArray ByteArray
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
      newM  ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
left
      A.copyI rightLen newM (leftOff + leftLen) right rightOff
      new  A.unsafeFreeze newM
      pure $ Text new leftOff (leftLen + rightLen)
    else
      if Bool
canCopyToRight
        then do
          newM  ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
right
          A.copyI leftLen newM (rightOff - leftLen) left leftOff
          new  A.unsafeFreeze newM
          pure $ Text new (rightOff - leftLen) (leftLen + 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)
          newM  (if ByteArray -> Bool
isPinned ByteArray
left Bool -> Bool -> Bool
|| ByteArray -> Bool
isPinned ByteArray
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
          A.copyI leftLen newM leftOff left leftOff
          A.copyI rightLen newM (leftOff + leftLen) right rightOff
          new  A.unsafeFreeze newM
          pure $ Text new leftOff (leftLen + rightLen)