module Data.Text.Builder.Common.Internal where

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

-- | 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 (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 (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 :: 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 (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 (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 (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 (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 (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 (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 (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 #-}