{-# LANGUAGE CPP #-}
{-# 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 Data.Text.Builder.Common.Compat (Codepoint)
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 :: 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) =
  forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder (Int
len1 forall a. Num a => a -> a -> a
+ Int
len2) forall a b. (a -> b) -> a -> b
$ \Int
ix1 MArray s
marr a
a -> do
    Int
ix2 <- forall s. Int -> MArray s -> a -> ST s Int
f Int
ix1 MArray s
marr a
a
    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
(<>) = forall a. Builder a -> Builder a -> Builder a
appendBuilder

instance Monoid (Builder a) where
  {-# INLINE mempty #-}
  mempty :: Builder a
mempty = forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
0 (\Int
i MArray s
_ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
i)
  {-# INLINE mappend #-}
  mappend :: Builder a -> Builder a -> Builder a
mappend = 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 a. (forall s. ST s (MArray s, a)) -> (Array, a)
A.run2 forall a b. (a -> b) -> a -> b
$ do
        MArray s
marr <- forall s. Int -> ST s (MArray s)
A.new Int
maxLen
        Int
finalIx <- forall s. Int -> MArray s -> a -> ST s Int
f Int
0 MArray s
marr a
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) = forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
len forall a b. (a -> b) -> a -> b
$ \Int
i MArray s
marr b
b ->
  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 = forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
1 forall a b. (a -> b) -> a -> b
$ \Int
i MArray s
marr Char
c -> do
  forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE charBmp #-}

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

word8 :: Builder Word8
word8 :: Builder Word8
word8 = forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder Int
3 forall a b. (a -> b) -> a -> b
$ \Int
pos MArray s
marr Word8
w -> if
  | Word8
w forall a. Ord a => a -> a -> Bool
< Word8
10 -> do
      forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr Int
pos (forall a. Integral a => a -> Codepoint
i2w Word8
w)
      forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos forall a. Num a => a -> a -> a
+ Int
1)
  | Word8
w forall a. Ord a => a -> a -> Bool
< Word8
100 -> do
      let wInt :: Int
wInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
          ix :: Int
ix = Int
wInt forall a. Num a => a -> a -> a
+ Int
wInt
      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)
      forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos forall a. Num a => a -> a -> a
+ Int
1) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.twoDecimalDigits (Int
ix forall a. Num a => a -> a -> a
+ Int
1))
      forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos forall a. Num a => a -> a -> a
+ Int
2)
  | Bool
otherwise -> do
      let wInt :: Int
wInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
          ix :: Int
ix = Int
wInt forall a. Num a => a -> a -> a
+ Int
wInt forall a. Num a => a -> a -> a
+ Int
wInt
      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)
      forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos forall a. Num a => a -> a -> a
+ Int
1) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.threeDecimalDigits (Int
ix forall a. Num a => a -> a -> a
+ Int
1))
      forall s. MArray s -> Int -> Codepoint -> ST s ()
A.unsafeWrite MArray s
marr (Int
pos forall a. Num a => a -> a -> a
+ Int
2) (Array -> Int -> Codepoint
A.unsafeIndex Array
I.threeDecimalDigits (Int
ix forall a. Num a => a -> a -> a
+ Int
2))
      forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pos 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 = 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 forall a.
Int -> (forall s. Int -> MArray s -> a -> ST s Int) -> Builder a
Builder
        (forall a. Ord a => Vector a -> a
Vector.maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
Vector.map Text -> Int
I.portableTextLength forall a b. (a -> b) -> a -> b
$ forall a. a -> Vector a -> Vector a
Vector.cons Text
tDef Vector Text
v)
        forall a b. (a -> b) -> a -> b
$ \Int
_ MArray s
marr Int
i -> do
          let (Array
arr,Int
len) = forall a. a -> Maybe a -> a
fromMaybe (Array, Int)
xDef (Vector (Array, Int)
xs forall a. Vector a -> Int -> Maybe a
Vector.!? Int
i)
              finalIx :: Int
finalIx = Int
i forall a. Num a => a -> a -> a
+ Int
len
#if MIN_VERSION_text(2, 0, 0)
          A.copyI finalIx marr i arr 0
#else
          forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
A.copyI MArray s
marr Int
i Array
arr Int
0 Int
finalIx
#endif
          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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
{-# INLINE i2w #-}

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