{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternSynonyms #-}

-- | @Data.Builder.Catenable@ specialized to @ShortText@.
module Data.Builder.Catenable.Text
  ( -- * Type
    Builder (..)

    -- * Convenient infix operators
  , pattern (:<)
  , pattern (:>)

    -- * Run
  , run

    -- * Properties
  , length

    -- * Create
  , shortText
  , char
  , word32Dec
  , word64Dec
  , int32Dec
  , int64Dec
  ) where

import Prelude hiding (length)

import Control.Monad.ST (ST, runST)
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.Bytes.Chunks (Chunks (ChunksNil))
import Data.Int (Int32, Int64)
import Data.Primitive (ByteArray (ByteArray))
import Data.String (IsString (fromString))
import Data.Text.Short (ShortText)
import Data.Word (Word32, Word64)

import qualified Arithmetic.Nat as Nat
import qualified Data.Bytes.Builder as BB
import qualified Data.Bytes.Builder.Bounded as Bounded
import qualified Data.Bytes.Builder.Unsafe as BBU
import qualified Data.Bytes.Chunks as Chunks
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS

infixr 5 :<
infixl 5 :>

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

shortText :: ShortText -> Builder
shortText :: ShortText -> Builder
shortText !ShortText
t = ShortText -> Builder -> Builder
Cons ShortText
t Builder
Empty

char :: Char -> Builder
char :: Char -> Builder
char !Char
c = ShortText -> Builder -> Builder
Cons (Char -> ShortText
TS.singleton Char
c) Builder
Empty

word32Dec :: Word32 -> Builder
word32Dec :: Word32 -> Builder
word32Dec !Word32
i = ShortText -> Builder -> Builder
Cons (ByteArray -> ShortText
ba2st (Nat 10 -> Builder 10 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run Nat 10
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Word32 -> Builder 10
Bounded.word32Dec Word32
i))) Builder
Empty

word64Dec :: Word64 -> Builder
word64Dec :: Word64 -> Builder
word64Dec !Word64
i = ShortText -> Builder -> Builder
Cons (ByteArray -> ShortText
ba2st (Nat 19 -> Builder 19 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run Nat 19
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Word64 -> Builder 19
Bounded.word64Dec Word64
i))) Builder
Empty

int32Dec :: Int32 -> Builder
int32Dec :: Int32 -> Builder
int32Dec !Int32
i = ShortText -> Builder -> Builder
Cons (ByteArray -> ShortText
ba2st (Nat 11 -> Builder 11 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run Nat 11
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Int32 -> Builder 11
Bounded.int32Dec Int32
i))) Builder
Empty

int64Dec :: Int64 -> Builder
int64Dec :: Int64 -> Builder
int64Dec !Int64
i = ShortText -> Builder -> Builder
Cons (ByteArray -> ShortText
ba2st (Nat 20 -> Builder 20 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
Bounded.run Nat 20
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Int64 -> Builder 20
Bounded.int64Dec Int64
i))) Builder
Empty

-- | Number of Unicode code points in the sequence.
length :: Builder -> Int
length :: Builder -> Int
length Builder
b0 = case Builder
b0 of
  Builder
Empty -> Int
0
  Cons ShortText
x Builder
b1 -> ShortText -> Int
TS.length ShortText
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
b1
  Snoc Builder
b1 ShortText
x -> ShortText -> Int
TS.length ShortText
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
b1
  Append Builder
x Builder
y -> Builder -> Int
length Builder
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
y

{- | 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

{- | Not structural equality. Converts builders to chunks and then
compares the chunks.
-}
instance Eq Builder where
  Builder
a == :: Builder -> Builder -> Bool
== Builder
b = Builder -> Chunks
run Builder
a Chunks -> Chunks -> Bool
forall a. Eq a => a -> a -> Bool
== Builder -> Chunks
run Builder
b

instance Show Builder where
  show :: Builder -> String
show Builder
b = ShortText -> String
TS.unpack (ByteArray -> ShortText
ba2st (Chunks -> ByteArray
Chunks.concatU (Builder -> Chunks
run Builder
b)))

ba2st :: ByteArray -> ShortText
{-# INLINE ba2st #-}
ba2st :: ByteArray -> ShortText
ba2st (ByteArray ByteArray#
x) = ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
x)

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

pattern (:>) :: Builder -> ShortText -> Builder
pattern $m:> :: forall {r}.
Builder -> (Builder -> ShortText -> r) -> ((# #) -> r) -> r
$b:> :: Builder -> ShortText -> Builder
(:>) 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 :: forall s. 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 a. a -> ST s a
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