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

{-| 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 Data.Word
import Data.Text (Text)
import Control.Monad.ST
import Data.Char (ord)
import Data.Vector (Vector)
import Data.Maybe (fromMaybe)
import qualified Data.Vector as Vector
import qualified Data.Semigroup as Semigroup
import qualified Data.Text.Array as A
import qualified Data.Text.Builder.Common.Internal as I
import qualified Data.Text.Internal as TI

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

-- 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
          MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
i Array
arr Int
0 Int
finalIx
          Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
finalIx
{-# INLINE _vector #-}

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

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