{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}

{- | This is a builder optimized for concatenating short
    variable-length strings whose length has a known upper
    bound. In these cases, this can be up to ten times faster
    than the builder provided by the @text@ library. However,
    data whose textual encoding has no known upper bound cannot
    be encoded by the builder provided here. For example, it
    is possible to provide decimal builders for types like 'Data.Int.Int8' and
    'Word16', whose lengths are respectively bounded by
    4 and 5. However, this is not possible for 'Integer', since
    its decimal representation could be arbitrarily long.
-}
module Data.Text.Builder.Variable
  ( Builder
  , run
  , contramap
  , charBmp
  , staticCharBmp
  , word8
  ) where

import Control.Monad.ST
import Data.Char (ord)
import Data.Maybe (fromMaybe)
import qualified Data.Semigroup as Semigroup
import Data.Text (Text)
import qualified Data.Text.Array as A
import Data.Text.Builder.Common.Compat (Codepoint)
import qualified Data.Text.Builder.Common.Internal as I
import qualified Data.Text.Internal as TI
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Word

data Builder a
  = Builder
      {-# UNPACK #-} !Int -- the maximum length, not a character count
      !(forall s. Int -> A.MArray s -> a -> ST s Int)

{-# INLINE appendBuilder #-}
appendBuilder :: Builder a -> Builder a -> Builder a
appendBuilder :: forall a. Builder a -> Builder a -> Builder a
appendBuilder (Builder Int
len1 forall s. Int -> MArray s -> a -> ST s Int
f) (Builder Int
len2 forall s. Int -> MArray s -> a -> ST s Int
g) =
  Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2) ((forall s. Int -> MArray s -> a -> ST s Int) -> Builder a)
-> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Int
ix1 MArray s
marr a
a -> do
    Int
ix2 <- Int -> MArray s -> a -> ST s Int
forall s. Int -> MArray s -> a -> ST s Int
f Int
ix1 MArray s
marr a
a
    Int -> MArray s -> a -> ST s Int
forall s. Int -> MArray s -> a -> ST s Int
g Int
ix2 MArray s
marr a
a

instance Semigroup.Semigroup (Builder a) where
  {-# INLINE (<>) #-}
  <> :: Builder a -> Builder a -> Builder a
(<>) = Builder a -> Builder a -> Builder a
forall a. Builder a -> Builder a -> Builder a
appendBuilder

instance Monoid (Builder a) where
  {-# INLINE mempty #-}
  mempty :: Builder a
mempty = Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
0 (\Int
i MArray s
_ a
_ -> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i)
  {-# INLINE mappend #-}
  mappend :: Builder a -> Builder a -> Builder a
mappend = Builder a -> Builder a -> Builder a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

run :: Builder a -> a -> Text
run :: forall a. Builder a -> a -> Text
run (Builder Int
maxLen forall s. Int -> MArray s -> a -> ST s Int
f) = \a
a ->
  let (Array
outArr, Int
len) = (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
A.run2 ((forall s. ST s (MArray s, Int)) -> (Array, Int))
-> (forall s. ST s (MArray s, Int)) -> (Array, Int)
forall a b. (a -> b) -> a -> b
$ do
        MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
maxLen
        Int
finalIx <- Int -> MArray s -> a -> ST s Int
forall s. Int -> MArray s -> a -> ST s Int
f Int
0 MArray s
marr a
a
        (MArray s, Int) -> ST s (MArray s, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
marr, Int
finalIx)
   in Array -> Int -> Int -> Text
TI.text Array
outArr Int
0 Int
len
{-# INLINE run #-}

contramap :: (b -> a) -> Builder a -> Builder b
contramap :: forall b a. (b -> a) -> Builder a -> Builder b
contramap b -> a
f (Builder Int
len forall s. Int -> MArray s -> a -> ST s Int
g) = Int -> (forall {s}. Int -> MArray s -> b -> ST s Int) -> Builder b
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
len ((forall {s}. Int -> MArray s -> b -> ST s Int) -> Builder b)
-> (forall {s}. Int -> MArray s -> b -> ST s Int) -> Builder b
forall a b. (a -> b) -> a -> b
$ \Int
i MArray s
marr b
b ->
  Int -> MArray s -> a -> ST s Int
forall s. Int -> MArray s -> a -> ST s Int
g Int
i MArray s
marr (b -> a
f b
b)
{-# INLINE contramap #-}

-- finish writing this. it's important for completeness
-- char :: Builder a
-- char = Builder 2 $ \

-- | A character in the basic multilingual plane.
charBmp :: Builder Char
charBmp :: Builder Char
charBmp = Int
-> (forall {s}. Int -> MArray s -> Char -> ST s Int)
-> Builder Char
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
1 ((forall {s}. Int -> MArray s -> Char -> ST s Int) -> Builder Char)
-> (forall {s}. Int -> MArray s -> Char -> ST s Int)
-> Builder Char
forall a b. (a -> b) -> a -> b
$ \Int
i MArray s
marr Char
c -> do
  MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
i (Int -> Codepoint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))
  Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE charBmp #-}

staticCharBmp :: Char -> Builder a
staticCharBmp :: forall a. Char -> Builder a
staticCharBmp Char
c = Int -> (forall {s}. Int -> MArray s -> a -> ST s Int) -> Builder a
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
1 ((forall {s}. Int -> MArray s -> a -> ST s Int) -> Builder a)
-> (forall {s}. Int -> MArray s -> a -> ST s Int) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Int
i MArray s
marr a
_ -> do
  MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
i (Int -> Codepoint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))
  Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE staticCharBmp #-}

word8 :: Builder Word8
word8 :: Builder Codepoint
word8 = Int
-> (forall {s}. Int -> MArray s -> Codepoint -> ST s Int)
-> Builder Codepoint
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
3 ((forall {s}. Int -> MArray s -> Codepoint -> ST s Int)
 -> Builder Codepoint)
-> (forall {s}. Int -> MArray s -> Codepoint -> ST s Int)
-> Builder Codepoint
forall a b. (a -> b) -> a -> b
$ \Int
pos MArray s
marr Codepoint
w ->
  if
    | Codepoint
w Codepoint -> Codepoint -> Bool
forall a. Ord a => a -> a -> Bool
< Codepoint
10 -> do
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
pos (Codepoint -> Codepoint
forall a. Integral a => a -> Codepoint
i2w Codepoint
w)
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Codepoint
w Codepoint -> Codepoint -> Bool
forall a. Ord a => a -> a -> Bool
< Codepoint
100 -> do
        let wInt :: Int
wInt = Codepoint -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Codepoint
w
            ix :: Int
ix = Int
wInt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wInt
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
pos (Array -> Int -> Codepoint
A.unsafeIndex Array
I.twoDecimalDigits Int
ix)
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.twoDecimalDigits (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    | Bool
otherwise -> do
        let wInt :: Int
wInt = Codepoint -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Codepoint
w
            ix :: Int
ix = Int
wInt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wInt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wInt
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
pos (Array -> Int -> Codepoint
A.unsafeIndex Array
I.threeDecimalDigits Int
ix)
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.threeDecimalDigits (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        MArray s -> Int -> Codepoint -> ST s ()
forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.threeDecimalDigits (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
{-# INLINE word8 #-}

{- FOURMOLU_DISABLE -}
-- This has not yet been tested.
_vector ::
     Text -- ^ Default, used when index is out of range
  -> Vector Text -- ^ Texts to index into
  -> Builder Int
_vector :: Text -> Vector Text -> Builder Int
_vector Text
tDef Vector Text
v =
  let xs :: Vector (Array, Int)
xs = (Text -> (Array, Int)) -> Vector Text -> Vector (Array, Int)
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map Text -> (Array, Int)
I.portableUntext Vector Text
v
      xDef :: (Array, Int)
xDef = Text -> (Array, Int)
I.portableUntext Text
tDef
   in Int
-> (forall {s}. Int -> MArray s -> Int -> ST s Int) -> Builder Int
forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder
        (Vector Int -> Int
forall a. Ord a => Vector a -> a
Vector.maximum (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> Vector Text -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map Text -> Int
I.portableTextLength (Vector Text -> Vector Int) -> Vector Text -> Vector Int
forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
forall a. a -> Vector a -> Vector a
Vector.cons Text
tDef Vector Text
v)
        ((forall {s}. Int -> MArray s -> Int -> ST s Int) -> Builder Int)
-> (forall {s}. Int -> MArray s -> Int -> ST s Int) -> Builder Int
forall a b. (a -> b) -> a -> b
$ \Int
_ MArray s
marr Int
i -> do
          let (Array
arr,Int
len) = (Array, Int) -> Maybe (Array, Int) -> (Array, Int)
forall a. a -> Maybe a -> a
fromMaybe (Array, Int)
xDef (Vector (Array, Int)
xs Vector (Array, Int) -> Int -> Maybe (Array, Int)
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
i)
              finalIx :: Int
finalIx = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
#if MIN_VERSION_text(2, 0, 0)
          Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
finalIx MArray s
marr Int
i Array
arr Int
0
#else
          A.copyI marr i arr 0 finalIx
#endif
          Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
finalIx
{-# INLINE _vector #-}

i2w :: Integral a => a -> Codepoint
i2w :: forall a. Integral a => a -> Codepoint
i2w a
v = Codepoint
asciiZero Codepoint -> Codepoint -> Codepoint
forall a. Num a => a -> a -> a
+ a -> Codepoint
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
{-# INLINE i2w #-}
{- FOURMOLU_ENABLE -}

asciiZero :: Codepoint
asciiZero :: Codepoint
asciiZero = Codepoint
48
{-# INLINE asciiZero #-}