-- |
-- 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 → 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 → forall s. MArray s -> Int -> Char -> ST s Int
unsafePrependCharM MArray s
dst Int
dstOff Char
ch)
    (\MArray s
dst Int
dstOff → 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
1) Word8
n0
    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
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
2) Word8
n0
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
1) Word8
n1
    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
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
3) Word8
n0
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
2) Word8
n1
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
1) Word8
n2
    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
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
4) Word8
n0
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
3) Word8
n1
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
2) Word8
n2
    forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
- Int
1) Word8
n3
    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 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 forall a. Num a => a -> a -> a
* 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 → forall s. MArray s -> Int -> Int -> Int -> ST s ()
unsafeReplicate MArray s
dst Int
dstOff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
count) (Char -> Int
ord Char
ch)
                  else \MArray s
dst Int
dstOff → forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff Char
ch forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 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 forall a. Num a => a -> a -> a
* 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 → forall s. MArray s -> Int -> Int -> Int -> ST s ()
unsafeReplicate MArray s
dst Int
dstOff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
count) (Char -> Int
ord Char
ch)
                  else \MArray s
dst Int
dstOff → forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dst Int
dstOff Char
ch forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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` "foo" `appendJustified` "bar")
-- "Test:         foo         bar"
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 #) →
    forall a. (Word -> a) -> Word %1 -> a
toLinearWord
      (\Word
l Buffer
b → if Word
n forall a. Ord a => a -> a -> Bool
<= Word
l then Buffer
b else Word -> Char -> Buffer %1 -> Buffer
prependChars (Word
n 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 #) →
    forall a. (Word -> a) -> Word %1 -> a
toLinearWord
      (\Word
l Buffer
b → if Word
n forall a. Ord a => a -> a -> Bool
<= Word
l then Buffer
b else Word -> Char -> Buffer %1 -> Buffer
appendChars (Word
n 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 #) →
    forall a. (Word -> a) -> Word %1 -> a
toLinearWord
      ( \Word
l Buffer
b →
          if Word
n forall a. Ord a => a -> a -> Bool
<= Word
l
            then Buffer
b
            else case Word
n forall a. Num a => a -> a -> a
- Word
l of
              !Word
d → case Word
d 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 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 = forall a b. a -> b
unsafeCoerce