    -- |
    -- Copyright:   (c) 2022 Andrew Lelechenko
    -- Licence:     BSD3
    -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
    module Data.Text.Builder.Linear.Char (
      -- * Single character
      (|>.),
      (.<|),

      -- * Multiple characters
      prependChars,
      appendChars,

      -- * Padding
      justifyLeft,
      justifyRight,
      center,
    ) where

    import Data.Char (isAscii)
    import Data.Text.Array qualified as A
    import Data.Text.Internal.Encoding.Utf8 (ord2, ord3, ord4, utf8Length)
    import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
    import GHC.ST (ST)
    import Unsafe.Coerce (unsafeCoerce)

    import Data.Text.Builder.Linear.Array (unsafeReplicate, unsafeTile)
    import Data.Text.Builder.Linear.Core

    --------------------------------------------------------------------------------
    -- Single char
    --------------------------------------------------------------------------------

    -- | Append 'Char' to a 'Buffer' by mutating it.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> b |>. 'q' |>. 'w')
    -- "qw"
    --
    -- __Warning:__ In contrast to 'Data.Text.Lazy.Builder.singleton', it is the
    -- responsibility of the caller to sanitize surrogate code points with
    -- 'Data.Text.Internal.safe'.
    (|>.) ∷ Buffer ⊸ Char → Buffer

    infixl 6 |>.
    Buffer
    buffer |>. :: Buffer %1 -> Char -> Buffer
    |>. Char
    ch = Int
    -> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
    appendBounded Int
    4 (\MArray s
    dst Int
    dstOff → MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafeWrite MArray s
    dst Int
    dstOff Char
    ch) Buffer
    buffer

    -- | Prepend 'Char' to a 'Buffer' by mutating it.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> 'q' .<| 'w' .<| b)
    -- "qw"
    --
    -- __Warning:__ In contrast to 'Data.Text.Lazy.Builder.singleton', it is the
    -- responsibility of the caller to sanitize surrogate code points with
    -- 'Data.Text.Internal.safe'.
    (.<|) ∷ Char → Buffer ⊸ Buffer

    infixr 6 .<|
    Char
    ch .<| :: Char -> Buffer %1 -> Buffer
    .<| Buffer
    buffer =
      Int
    -> (forall s. MArray s -> Int -> ST s Int)
    -> (forall s. MArray s -> Int -> ST s Int)
    -> Buffer
    %1 -> Buffer
    prependBounded
        Int
    4
        (\MArray s
    dst Int
    dstOff → MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafePrependCharM MArray s
    dst Int
    dstOff Char
    ch)
        (\MArray s
    dst Int
    dstOff → MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafeWrite MArray s
    dst Int
    dstOff Char
    ch)
        Buffer
    buffer

    -- | Similar to 'Data.Text.Internal.Unsafe.Char.unsafeWrite',
    -- but writes _before_ a given offset.
    unsafePrependCharM ∷ A.MArray s → Int → Char → ST s Int
    unsafePrependCharM :: forall s. MArray s -> Int -> Char -> ST s Int
    unsafePrependCharM MArray s
    marr Int
    off Char
    c = case Char -> Int
    utf8Length Char
    c of
      Int
    1 → do
        let n0 :: Word8
    n0 = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c)
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    n0
        Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    1
      Int
    2 → do
        let (Word8
    n0, Word8
    n1) = Char -> (Word8, Word8)
    ord2 Char
    c
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Word8
    n0
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    n1
        Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    2
      Int
    3 → do
        let (Word8
    n0, Word8
    n1, Word8
    n2) = Char -> (Word8, Word8, Word8)
    ord3 Char
    c
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) Word8
    n0
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Word8
    n1
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    n2
        Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    3
      Int
    _ → do
        let (Word8
    n0, Word8
    n1, Word8
    n2, Word8
    n3) = Char -> (Word8, Word8, Word8, Word8)
    ord4 Char
    c
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4) Word8
    n0
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) Word8
    n1
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Word8
    n2
        MArray s -> Int -> Word8 -> ST s ()
    forall s. MArray s -> Int -> Word8 -> ST s ()
    A.unsafeWrite MArray s
    marr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    n3
        Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    4

    --------------------------------------------------------------------------------
    -- Multiple chars
    --------------------------------------------------------------------------------

    -- | Prepend a given count of a 'Char' to a 'Buffer'.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> prependChars 3 'x' (b |>. 'A'))
    -- "xxxA"
    prependChars ∷ Word → Char → Buffer ⊸ Buffer
    prependChars :: Word -> Char -> Buffer %1 -> Buffer
    prependChars Word
    count Char
    ch Buffer
    buff
      | Word
    count Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    0 = Buffer
    buff
      | Bool
    otherwise =
          case Char -> Int
    utf8Length Char
    ch of
            Int
    cLen → case Int
    cLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    count of
              Int
    totalLen →
                Int
    -> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
    prependExact
                  Int
    totalLen
                  ( if Char -> Bool
    isAscii Char
    ch
                      then \MArray s
    dst Int
    dstOff → MArray s -> Int -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> Int -> ST s ()
    unsafeReplicate MArray s
    dst Int
    dstOff (Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    count) (Char -> Int
    ord Char
    ch)
                      else \MArray s
    dst Int
    dstOff → MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafeWrite MArray s
    dst Int
    dstOff Char
    ch ST s Int -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> MArray s -> Int -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> Int -> ST s ()
    unsafeTile MArray s
    dst Int
    dstOff Int
    totalLen Int
    cLen
                  )
                  Buffer
    buff

    -- | Apppend a given count of a 'Char' to a 'Buffer'.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> appendChars 3 'x' (b |>. 'A'))
    -- "Axxx"
    appendChars ∷ Word → Char → Buffer ⊸ Buffer
    appendChars :: Word -> Char -> Buffer %1 -> Buffer
    appendChars Word
    count Char
    ch Buffer
    buff
      | Word
    count Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    0 = Buffer
    buff
      | Bool
    otherwise =
          case Char -> Int
    utf8Length Char
    ch of
            Int
    cLen → case Int
    cLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    count of
              Int
    totalLen →
                Int
    -> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
    appendExact
                  Int
    totalLen
                  ( if Char -> Bool
    isAscii Char
    ch
                      then \MArray s
    dst Int
    dstOff → MArray s -> Int -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> Int -> ST s ()
    unsafeReplicate MArray s
    dst Int
    dstOff (Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    count) (Char -> Int
    ord Char
    ch)
                      else \MArray s
    dst Int
    dstOff → MArray s -> Int -> Char -> ST s Int
    forall s. MArray s -> Int -> Char -> ST s Int
    unsafeWrite MArray s
    dst Int
    dstOff Char
    ch ST s Int -> ST s () -> ST s ()
    forall a b. ST s a -> ST s b -> ST s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> MArray s -> Int -> Int -> Int -> ST s ()
    forall s. MArray s -> Int -> Int -> Int -> ST s ()
    unsafeTile MArray s
    dst Int
    dstOff Int
    totalLen Int
    cLen
                  )
                  Buffer
    buff

    --------------------------------------------------------------------------------
    -- Padding
    --------------------------------------------------------------------------------

    -- | Pad a builder from the /left/ side to the specified length with the specified
    -- character.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> justifyRight 10 'x' (appendChars 3 'A' b))
    -- "xxxxxxxAAA"
    -- >>> runBuffer (\b -> justifyRight 5 'x' (appendChars 6 'A' b))
    -- "AAAAAA"
    --
    -- Note that 'newEmptyBuffer' is needed in some situations. 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"
    justifyRight ∷ Word → Char → Buffer ⊸ Buffer
    justifyRight :: Word -> Char -> Buffer %1 -> Buffer
    justifyRight Word
    n Char
    ch Buffer
    buff = case Buffer %1 -> (# Buffer, Word #)
    lengthOfBuffer Buffer
    buff of
      (# Buffer
    buff', Word
    len #) →
        (Word -> Buffer %1 -> Buffer) -> Word %1 -> Buffer %1 -> Buffer
    forall a. (Word -> a) -> Word %1 -> a
    toLinearWord
          (\Word
    l Buffer
    b → if Word
    n Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    l then Buffer
    b else Word -> Char -> Buffer %1 -> Buffer
    prependChars (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    l) Char
    ch Buffer
    b)
          Word
    len
          Buffer
    buff'

    -- | Pad a builder from the /right/ side to the specified length with the specified
    -- character.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> justifyLeft 10 'x' (appendChars 3 'A' b))
    -- "AAAxxxxxxx"
    -- >>> runBuffer (\b -> justifyLeft 5 'x' (appendChars 6 'A' b))
    -- "AAAAAA"
    --
    -- Note that 'newEmptyBuffer' is needed in some situations. See 'justifyRight'
    -- for an example.
    justifyLeft ∷ Word → Char → Buffer ⊸ Buffer
    justifyLeft :: Word -> Char -> Buffer %1 -> Buffer
    justifyLeft Word
    n Char
    ch Buffer
    buff = case Buffer %1 -> (# Buffer, Word #)
    lengthOfBuffer Buffer
    buff of
      (# Buffer
    buff', Word
    len #) →
        (Word -> Buffer %1 -> Buffer) -> Word %1 -> Buffer %1 -> Buffer
    forall a. (Word -> a) -> Word %1 -> a
    toLinearWord
          (\Word
    l Buffer
    b → if Word
    n Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    l then Buffer
    b else Word -> Char -> Buffer %1 -> Buffer
    appendChars (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    l) Char
    ch Buffer
    b)
          Word
    len
          Buffer
    buff'

    -- | Center a builder to the specified length with the specified character.
    --
    -- >>> :set -XLinearTypes
    -- >>> runBuffer (\b -> center 10 'x' (appendChars 3 'A' b))
    -- "xxxxAAAxxx"
    -- >>> runBuffer (\b -> center 5 'x' (appendChars 6 'A' b))
    -- "AAAAAA"
    --
    -- Note that 'newEmptyBuffer' is needed in some situations. See 'justifyRight'
    -- for an example.
    center ∷ Word → Char → Buffer ⊸ Buffer
    center :: Word -> Char -> Buffer %1 -> Buffer
    center Word
    n Char
    ch Buffer
    buff = case Buffer %1 -> (# Buffer, Word #)
    lengthOfBuffer Buffer
    buff of
      (# Buffer
    buff', Word
    len #) →
        (Word -> Buffer %1 -> Buffer) -> Word %1 -> Buffer %1 -> Buffer
    forall a. (Word -> a) -> Word %1 -> a
    toLinearWord
          ( \Word
    l Buffer
    b →
              if Word
    n Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    l
                then Buffer
    b
                else case Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    l of
                  !Word
    d → case Word
    d Word -> Word -> Word
    forall a. Integral a => a -> a -> a
    `quot` Word
    2 of
                    !Word
    r → Word -> Char -> Buffer %1 -> Buffer
    appendChars Word
    r Char
    ch (Word -> Char -> Buffer %1 -> Buffer
    prependChars (Word
    d Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - Word
    r) Char
    ch Buffer
    b)
          )
          Word
    len
          Buffer
    buff'

    -- Despite the use of unsafeCoerce, this is safe.
    toLinearWord ∷ (Word → a) → (Word ⊸ a)
    toLinearWord :: forall a. (Word -> a) -> Word %1 -> a
    toLinearWord = (Word -> a) -> Word %1 -> a
    forall a b. a -> b
    unsafeCoerce