packages feed

text-builder-linear-0.1: src/Data/Text/Builder/Linear/Char.hs

-- |
-- Copyright:   (c) 2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>

module Data.Text.Builder.Linear.Char
  ( -- * Buffer
    (|>.)
  , (.<|)
  ) where

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

import Data.Text.Builder.Linear.Core

-- | Append 'Char' to a 'Buffer' by mutating it.
--
-- >>> :set -XLinearTypes
-- >>> runBuffer (\b -> b |>. 'q' |>. 'w')
-- "qw"
--
(|>.) ∷ Buffer ⊸ Char → Buffer
infixl 6 |>.
buffer |>. ch = appendBounded 4 (\dst dstOff → unsafeWrite dst dstOff ch) buffer

-- | Prepend 'Char' to a 'Buffer' by mutating it.
--
-- >>> :set -XLinearTypes
-- >>> runBuffer (\b -> 'q' .<| 'w' .<| b)
-- "qw"
--
(.<|) ∷ Char → Buffer ⊸ Buffer
infixr 6 .<|
ch .<| buffer = prependBounded
  4
  (\dst dstOff → unsafePrependCharM dst dstOff ch)
  (\dst dstOff → unsafeWrite dst dstOff ch)
  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 marr off c = case utf8Length c of
  1 → do
    let n0 = fromIntegral (ord c)
    A.unsafeWrite marr (off - 1) n0
    pure 1
  2 → do
    let (n0, n1) = ord2 c
    A.unsafeWrite marr (off - 2) n0
    A.unsafeWrite marr (off - 1) n1
    pure 2
  3 → do
    let (n0, n1, n2) = ord3 c
    A.unsafeWrite marr (off - 3) n0
    A.unsafeWrite marr (off - 2) n1
    A.unsafeWrite marr (off - 1) n2
    pure 3
  _ → do
    let (n0, n1, n2, n3) = ord4 c
    A.unsafeWrite marr (off - 4) n0
    A.unsafeWrite marr (off - 3) n1
    A.unsafeWrite marr (off - 2) n2
    A.unsafeWrite marr (off - 1) n3
    pure 4