module Data.Text.Builder.Common.Internal where

import Control.Monad.ST
import Data.Char (ord)
import Data.Foldable (fold)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Unsafe.Char as TC
import Text.Printf

{- | This is slower that just pattern matching on the Text data constructor.
  However, it will work with GHCJS. This should only be used in places
  where we know that it will only be evaluated once.
-}
portableTextArray :: Text -> A.Array
portableTextArray :: Text -> Array
portableTextArray = (Array, Int) -> Array
forall a b. (a, b) -> a
fst ((Array, Int) -> Array) -> (Text -> (Array, Int)) -> Text -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Array, Int)
portableUntext
{-# INLINE portableTextArray #-}

{- | This length is not the character length. It is the length of Word16s
  required by a UTF16 representation.
-}
portableTextLength :: Text -> Int
portableTextLength :: Text -> Int
portableTextLength = (Array, Int) -> Int
forall a b. (a, b) -> b
snd ((Array, Int) -> Int) -> (Text -> (Array, Int)) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Array, Int)
portableUntext
{-# INLINE portableTextLength #-}

portableUntext :: Text -> (A.Array, Int)
portableUntext :: Text -> (Array, Int)
portableUntext Text
t =
  let str :: String
str = Text -> String
Text.unpack Text
t
      Sum Int
len = (Char -> Sum Int) -> String -> Sum Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Char -> Int) -> Char -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
charUtf16Size) String
str
      arr :: Array
arr = (forall s. ST s (MArray s)) -> Array
A.run ((forall s. ST s (MArray s)) -> Array)
-> (forall s. ST s (MArray s)) -> Array
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
len
        MArray s -> String -> ST s ()
forall s. MArray s -> String -> ST s ()
writeString MArray s
marr String
str
        MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
marr
   in (Array
arr, Int
len)
{-# NOINLINE portableUntext #-}

writeString :: A.MArray s -> String -> ST s ()
writeString :: forall s. MArray s -> String -> ST s ()
writeString MArray s
marr = Int -> String -> ST s ()
go Int
0
 where
  go :: Int -> String -> ST s ()
go Int
i String
s = case String
s of
    Char
c : String
cs -> do
      Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
TC.unsafeWrite MArray s
marr Int
i Char
c
      Int -> String -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) String
cs
    [] -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

charUtf16Size :: Char -> Int
charUtf16Size :: Char -> Int
charUtf16Size Char
c = if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 then Int
1 else Int
2

hexValuesWord12Upper :: A.Array
hexValuesWord12Upper :: Array
hexValuesWord12Upper =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03X") [Int
0 :: Int .. Int
4096]
{-# NOINLINE hexValuesWord12Upper #-}

hexValuesWord12Lower :: A.Array
hexValuesWord12Lower :: Array
hexValuesWord12Lower =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03x") [Int
0 :: Int .. Int
4096]
{-# NOINLINE hexValuesWord12Lower #-}

hexValuesWord8Upper :: A.Array
hexValuesWord8Upper :: Array
hexValuesWord8Upper =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X") [Int
0 :: Int .. Int
255]
{-# NOINLINE hexValuesWord8Upper #-}

hexValuesWord8Lower :: A.Array
hexValuesWord8Lower :: Array
hexValuesWord8Lower =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02x") [Int
0 :: Int .. Int
255]
{-# NOINLINE hexValuesWord8Lower #-}

twoDecimalDigits :: A.Array
twoDecimalDigits :: Array
twoDecimalDigits =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    (Int -> Text) -> [Int] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d") [Int
0 :: Int .. Int
99]
{-# NOINLINE twoDecimalDigits #-}

threeDecimalDigits :: A.Array
threeDecimalDigits :: Array
threeDecimalDigits =
  Text -> Array
portableTextArray (Text -> Array) -> Text -> Array
forall a b. (a -> b) -> a -> b
$
    (Int -> Text) -> [Int] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03d") [Int
0 :: Int .. Int
255]
{-# NOINLINE threeDecimalDigits #-}