{-# language BangPatterns #-}
{-# language PatternSynonyms #-}

-- | @Data.Builder.Catenable@ specialized to @ShortText@.
module Data.Builder.Catenable.Text
  ( -- * Type
    Builder(..)
    -- * Convenient infix operators
  , pattern (:<)
  , pattern (:>)
    -- * Run
  , run
  ) where

import Control.Monad.ST (ST,runST)
import Data.Text.Short (ShortText)
import Data.Bytes.Chunks (Chunks(ChunksNil))
import Data.String (IsString(fromString))

import qualified Data.Text.Short as TS
import qualified Data.Bytes.Builder as BB
import qualified Data.Bytes.Builder.Unsafe as BBU

infixr 5 :<
infixl 5 :>

data Builder
  = Empty
  | Cons !ShortText !Builder
  | Snoc !Builder !ShortText
  | Append !Builder !Builder

-- | Note: The choice of appending to the left side of @Empty@ instead
-- of the right side of arbitrary. Under ordinary use, this difference
-- cannot be observed by the user.
instance IsString Builder where
  fromString :: String -> Builder
fromString String
t = ShortText -> Builder -> Builder
Cons (String -> ShortText
TS.pack String
t) Builder
Empty

instance Monoid Builder where
  {-# inline mempty #-}
  mempty :: Builder
mempty = Builder
Empty

instance Semigroup Builder where
  {-# inline (<>) #-}
  <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
Append

pattern (:<) :: ShortText -> Builder -> Builder
pattern $b:< :: ShortText -> Builder -> Builder
$m:< :: forall r.
Builder -> (ShortText -> Builder -> r) -> (Void# -> r) -> r
(:<) x y = Cons x y

pattern (:>) :: Builder -> ShortText -> Builder
pattern $b:> :: Builder -> ShortText -> Builder
$m:> :: forall r.
Builder -> (Builder -> ShortText -> r) -> (Void# -> r) -> r
(:>) x y = Snoc x y

-- | The result is chunks, but this is guaranteed to be UTF-8 encoded
-- text, so if needed, you can flatten out the chunks and convert back
-- to @ShortText@.
run :: Builder -> Chunks
{-# noinline run #-}
run :: Builder -> Chunks
run Builder
b = (forall s. ST s Chunks) -> Chunks
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Chunks) -> Chunks)
-> (forall s. ST s Chunks) -> Chunks
forall a b. (a -> b) -> a -> b
$ do
  BuilderState s
bldr0 <- Int -> ST s (BuilderState s)
forall s. Int -> ST s (BuilderState s)
BBU.newBuilderState Int
128
  BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
b
  Chunks -> Commits s -> ST s Chunks
forall s. Chunks -> Commits s -> ST s Chunks
BBU.reverseCommitsOntoChunks Chunks
ChunksNil (BuilderState s -> Commits s
forall s. BuilderState s -> Commits s
BBU.closeBuilderState BuilderState s
bldr1)

pushCatenable :: BBU.BuilderState s -> Builder -> ST s (BBU.BuilderState s)
pushCatenable :: BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable !BuilderState s
bldr0 Builder
b = case Builder
b of
  Builder
Empty -> BuilderState s -> ST s (BuilderState s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuilderState s
bldr0
  Cons ShortText
x Builder
b1 -> do
    BuilderState s
bldr1 <- Builder -> BuilderState s -> ST s (BuilderState s)
forall s. Builder -> BuilderState s -> ST s (BuilderState s)
BBU.pasteST (ShortText -> Builder
BB.shortTextUtf8 ShortText
x) BuilderState s
bldr0
    BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr1 Builder
b1
  Snoc Builder
b1 ShortText
x -> do
    BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
b1
    Builder -> BuilderState s -> ST s (BuilderState s)
forall s. Builder -> BuilderState s -> ST s (BuilderState s)
BBU.pasteST (ShortText -> Builder
BB.shortTextUtf8 ShortText
x) BuilderState s
bldr1
  Append Builder
x Builder
y -> do
    BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
x
    BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr1 Builder
y