{-# LANGUAGE OverloadedStrings, RankNTypes, PatternSynonyms, ViewPatterns,
             BangPatterns, MagicHash #-}

module Data.CSS.Syntax.Tokens
    ( Token(..)
    , NumericValue(..)
    , HashFlag(..)
    , Unit

    , tokenize
    , serialize
    ) where


import           Control.Applicative
import           Control.Monad

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import           Data.Monoid
import           Data.Char
import           Data.Scientific
import           Numeric

import           Prelude

import           Data.Text.Internal (Text(..))
import           Data.Text.Unsafe (inlineInterleaveST)
import qualified Data.Text.Array as A
import           Control.Monad.ST (ST)
import           GHC.Exts
import           GHC.Base (unsafeChr)
import           GHC.Word (Word8(..))
import           Data.Bits


data Token
    = Whitespace

    | CDO -- CommentDelimiterOpen
    | CDC -- CommentDelimiterClose

    | Comma
    | Colon
    | Semicolon

    | LeftParen
    | RightParen
    | LeftSquareBracket
    | RightSquareBracket
    | LeftCurlyBracket
    | RightCurlyBracket

    | SuffixMatch
    | SubstringMatch
    | PrefixMatch
    | DashMatch
    | IncludeMatch

    | Column

    | String !Text
    | BadString

    | Number !Text !NumericValue
    | Percentage !Text !NumericValue
    | Dimension !Text !NumericValue !Unit

    | Url !Text
    | BadUrl

    | Ident !Text

    | AtKeyword !Text

    | Function !Text

    | Hash !HashFlag !Text

    | Delim !Char

    deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq)


data NumericValue
    = NVInteger !Integer   -- ^ number without dot '.' or exponent 'e'
    | NVNumber !Scientific -- ^ number with dot '.' or exponent 'e'
    deriving (Int -> NumericValue -> ShowS
[NumericValue] -> ShowS
NumericValue -> String
(Int -> NumericValue -> ShowS)
-> (NumericValue -> String)
-> ([NumericValue] -> ShowS)
-> Show NumericValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumericValue -> ShowS
showsPrec :: Int -> NumericValue -> ShowS
$cshow :: NumericValue -> String
show :: NumericValue -> String
$cshowList :: [NumericValue] -> ShowS
showList :: [NumericValue] -> ShowS
Show, NumericValue -> NumericValue -> Bool
(NumericValue -> NumericValue -> Bool)
-> (NumericValue -> NumericValue -> Bool) -> Eq NumericValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumericValue -> NumericValue -> Bool
== :: NumericValue -> NumericValue -> Bool
$c/= :: NumericValue -> NumericValue -> Bool
/= :: NumericValue -> NumericValue -> Bool
Eq)

data HashFlag = HId | HUnrestricted
    deriving (Int -> HashFlag -> ShowS
[HashFlag] -> ShowS
HashFlag -> String
(Int -> HashFlag -> ShowS)
-> (HashFlag -> String) -> ([HashFlag] -> ShowS) -> Show HashFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashFlag -> ShowS
showsPrec :: Int -> HashFlag -> ShowS
$cshow :: HashFlag -> String
show :: HashFlag -> String
$cshowList :: [HashFlag] -> ShowS
showList :: [HashFlag] -> ShowS
Show, HashFlag -> HashFlag -> Bool
(HashFlag -> HashFlag -> Bool)
-> (HashFlag -> HashFlag -> Bool) -> Eq HashFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashFlag -> HashFlag -> Bool
== :: HashFlag -> HashFlag -> Bool
$c/= :: HashFlag -> HashFlag -> Bool
/= :: HashFlag -> HashFlag -> Bool
Eq)

type Unit = Text



-- Tokenization
-------------------------------------------------------------------------------


-- | Parse a 'Text' into a list of 'Token's.
--
-- https://drafts.csswg.org/css-syntax/#tokenization

tokenize :: Text -> [Token]
tokenize :: Text -> [Token]
tokenize = Text -> [Token]
parseTokens (Text -> [Token]) -> (Text -> Text) -> Text -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
preprocessInputStream



-- | Before sending the input stream to the tokenizer, implementations must
-- make the following code point substitutions: (see spec)
--
-- https://drafts.csswg.org/css-syntax/#input-preprocessing

preprocessInputStream :: Text -> Text
preprocessInputStream :: Text -> Text
preprocessInputStream t0 :: Text
t0@(Text Array
_ Int
_ Int
len) = Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
3) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ \ MArray s
dst -> do
    let go :: Text -> Int -> ST s Int
go Text
t Int
d = case Text
t of
            Char
'\x0D' :. Char
'\x0A' :. Text
t' ->
                Char -> Text -> ST s Int
put Char
'\x0A' Text
t'
            Char
'\x0D' :. Text
t' ->
                Char -> Text -> ST s Int
put Char
'\x0A' Text
t'
            Char
'\x0C' :. Text
t' ->
                Char -> Text -> ST s Int
put Char
'\x0A' Text
t'
            Char
'\x00' :. Text
t' -> do
                Int
d' <- MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d
                Text -> Int -> ST s Int
go Text
t' Int
d'
            Char
c :. Text
t' ->
                Char -> Text -> ST s Int
put Char
c Text
t'
            Text
_ ->
                Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
            where put :: Char -> Text -> ST s Int
put Char
x Text
t' = do
                      MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
x
                      Text -> Int -> ST s Int
go Text
t' (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Text -> Int -> ST s Int
go Text
t0 Int
0


-- Low level utilities
-------------------------------------------------------------------------------

pattern (:.) :: Char -> Text -> Text
pattern x $m:. :: forall {r}. Text -> (Char -> Text -> r) -> ((# #) -> r) -> r
:. xs <- (uncons -> Just (x, xs))

infixr 5 :.

-- | uncons first Word8 from Text without trying to decode UTF-8 sequence
uncons :: Text -> Maybe (Char, Text)
uncons :: Text -> Maybe (Char, Text)
uncons (Text Array
src Int
offs Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (Char, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise =
      (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Word8 -> Char
w2c (Array -> Int -> Word8
A.unsafeIndex Array
src Int
offs), Array -> Int -> Int -> Text
Text Array
src (Int
offsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
{-# INLINE uncons #-}

-- | write replacement character
writeFFFD :: A.MArray s -> Int -> ST s Int
writeFFFD :: forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d = MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst Int
d Char
'\xFFFD'

-- | write 8bit character
write :: A.MArray s -> Int -> Char -> ST s ()
write :: forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
x = MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
d (Char -> Word8
c2w Char
x)
{-# INLINE write #-}

-- | write character that could have more than 8bit
-- code from Data.Text.Internal.Unsafe.Char.unsafeWrite
writeChar :: A.MArray s -> Int -> Char -> ST s Int
writeChar :: forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
marr Int
i Char
c = case Char -> Int
utf8Length Char
c of
    Int
1 -> do
        let n0 :: Word8
n0 = Int -> Word8
intToWord8 (Char -> Int
ord Char
c)
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
i Word8
n0
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Int
2 -> do
        let (Word8
n0, Word8
n1) = Char -> (Word8, Word8)
ord2 Char
c
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
i     Word8
n0
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
n1
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
    Int
3 -> do
        let (Word8
n0, Word8
n1, Word8
n2) = Char -> (Word8, Word8, Word8)
ord3 Char
c
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
i     Word8
n0
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
n1
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
n2
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
    Int
_ -> do
        let (Word8
n0, Word8
n1, Word8
n2, Word8
n3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr Int
i     Word8
n0
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
n1
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
n2
        MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
n3
        Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)
{-# INLINE writeChar #-}

utf8Length :: Char -> Int
utf8Length :: Char -> Int
utf8Length (C# Char#
c) = Int# -> Int
I# ((Int#
1# Int# -> Int# -> Int#
+# Char# -> Char# -> Int#
geChar# Char#
c (Int# -> Char#
chr# Int#
0x80#)) Int# -> Int# -> Int#
+# (Char# -> Char# -> Int#
geChar# Char#
c (Int# -> Char#
chr# Int#
0x800#) Int# -> Int# -> Int#
+# Char# -> Char# -> Int#
geChar# Char#
c (Int# -> Char#
chr# Int#
0x10000#)))
{-# INLINE utf8Length #-}

ord2 :: Char -> (Word8,Word8)
ord2 :: Char -> (Word8, Word8)
ord2 Char
c = (Word8
x1,Word8
x2)
    where
      n :: Int
n  = Char -> Int
ord Char
c
      x1 :: Word8
x1 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xC0
      x2 :: Word8
x2 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F)   Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE ord2 #-}

ord3 :: Char -> (Word8,Word8,Word8)
ord3 :: Char -> (Word8, Word8, Word8)
ord3 Char
c = (Word8
x1,Word8
x2,Word8
x3)
    where
      n :: Int
n  = Char -> Int
ord Char
c
      x1 :: Word8
x1 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xE0
      x2 :: Word8
x2 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
      x3 :: Word8
x3 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE ord3 #-}

ord4 :: Char -> (Word8,Word8,Word8,Word8)
ord4 :: Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c = (Word8
x1,Word8
x2,Word8
x3,Word8
x4)
    where
      n :: Int
n  = Char -> Int
ord Char
c
      x1 :: Word8
x1 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xF0
      x2 :: Word8
x2 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
      x3 :: Word8
x3 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
      x4 :: Word8
x4 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE ord4 #-}

intToWord8 :: Int -> Word8
intToWord8 :: Int -> Word8
intToWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral


type Writer' s = (A.MArray s -> Int -> ST s Int, Text)
type Writer s = A.MArray s -> Int -> ST s (Int, Text)

-- | no-op for convenient pattern matching
w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2c #-}

c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}

withNewA :: Int -> (forall s . A.MArray s -> ST s Int) -> Text
withNewA :: Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA Int
len forall s. MArray s -> ST s Int
act = Array -> Int -> Int -> Text
Text Array
a Int
0 Int
l
    where (Array
a, Int
l) = (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
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
              Int
dLen <- MArray s -> ST s Int
forall s. MArray s -> ST s Int
act MArray s
dst
              (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
dst, Int
dLen)


-- Serialization
-------------------------------------------------------------------------------


-- | Serialize a list of 'Token's back into 'Text'.
--
-- Serialization "round-trips" with parsing:
--
--   tokenize (serialize (tokenize s)) == tokenize s
--
-- https://drafts.csswg.org/css-syntax/#serialization


serialize :: [Token] -> Text
serialize :: [Token] -> Text
serialize = Text -> Text
TL.toStrict (Text -> Text) -> ([Token] -> Text) -> [Token] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> Text) -> ([Token] -> Builder) -> [Token] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> Builder
go
    where go :: [Token] -> Builder
go [] = Builder
""
          go [Delim Char
'\\'] = Builder
"\\" -- do not add newline in last token
          go [Token
x] = Token -> Builder
renderToken Token
x
          go (Token
x:xs :: [Token]
xs@(Token
y:[Token]
_))
              | Token -> Token -> Bool
needComment Token
x Token
y = Token -> Builder
renderToken Token
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"/**/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Token] -> Builder
go [Token]
xs
              | Bool
otherwise = Token -> Builder
renderToken Token
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Token] -> Builder
go [Token]
xs

{-# INLINE renderToken #-}
{-# INLINE needComment #-}

needComment :: Token -> Token -> Bool
needComment :: Token -> Token -> Bool
needComment Token
a Token
CDC = case Token
a of
    -- Can't be parsed that way but may exists in generated `Token` list.
    -- It's also possible to make Delim 'a' which will be parsed as Ident
    -- but we can't do much in this case since it's impossible to
    -- create Delim 'a' tokens in parser.
    Delim Char
'!' -> Bool
True
    Delim Char
'@' -> Bool
True
    Delim Char
'#' -> Bool
True
    Delim Char
'-' -> Bool
True
    Number {} -> Bool
True
    Dimension {} -> Bool
True
    Ident Text
_ -> Bool
True
    AtKeyword Text
_ -> Bool
True
    Function Text
_ -> Bool
True
    Hash {} -> Bool
True
    Token
_ -> Bool
False
needComment Token
a Token
b = case Token
a of
    Token
Whitespace    -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
Whitespace
    Ident Text
"--"    -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'>' -- Looks like a CDC
    Ident Text
_       -> Bool
idn Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CDC Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
LeftParen
    AtKeyword Text
_   -> Bool
idn Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CDC
    Hash {}       -> Bool
idn Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CDC
    Dimension {}  -> Bool
idn Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CDC
    Delim Char
'#'     -> Bool
idn
    Delim Char
'-'     -> Bool
idn
    Number {}     -> Bool
i Bool -> Bool -> Bool
|| Bool
num Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'%'
    Delim Char
'@'     -> Bool
i Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'-'
    Delim Char
'.'     -> Bool
num
    Delim Char
'+'     -> Bool
num
    Delim Char
'/'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'*' Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
SubstringMatch
    Delim Char
'|'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'='
        Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'|' Bool -> Bool -> Bool
||  Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
Column Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
DashMatch
    Delim Char
'$'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'='
    Delim Char
'*'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'='
    Delim Char
'^'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'='
    Delim Char
'~'     -> Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'='
    Token
_             -> Bool
False
    where idn :: Bool
idn = Bool
i Bool -> Bool -> Bool
|| Token
b Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Delim Char
'-' Bool -> Bool -> Bool
|| Bool
num
          i :: Bool
i = case Token
b of
              Ident Text
_ -> Bool
True
              Function Text
_ -> Bool
True
              Url Text
_ -> Bool
True
              Token
BadUrl -> Bool
True
              Token
_ -> Bool
False
          num :: Bool
num = case Token
b of
              Number {} -> Bool
True
              Percentage {} -> Bool
True
              Dimension {} -> Bool
True
              Token
_ -> Bool
False


renderToken :: Token -> TLB.Builder
renderToken :: Token -> Builder
renderToken Token
token = case Token
token of
    Token
Whitespace         -> Char -> Builder
c Char
' '

    Token
CDO                -> Builder
"<!--"
    Token
CDC                -> Builder
"-->"

    Token
Comma              -> Char -> Builder
c Char
','
    Token
Colon              -> Char -> Builder
c Char
':'
    Token
Semicolon          -> Char -> Builder
c Char
';'

    Token
LeftParen          -> Char -> Builder
c Char
'('
    Token
RightParen         -> Char -> Builder
c Char
')'
    Token
LeftSquareBracket  -> Char -> Builder
c Char
'['
    Token
RightSquareBracket -> Char -> Builder
c Char
']'
    Token
LeftCurlyBracket   -> Char -> Builder
c Char
'{'
    Token
RightCurlyBracket  -> Char -> Builder
c Char
'}'

    Token
SuffixMatch        -> Builder
"$="
    Token
SubstringMatch     -> Builder
"*="
    Token
PrefixMatch        -> Builder
"^="
    Token
DashMatch          -> Builder
"|="
    Token
IncludeMatch       -> Builder
"~="

    Token
Column             -> Builder
"||"

    String Text
x           -> Text -> Builder
string Text
x
    Token
BadString          -> Builder
"\"\n"

    Number Text
x NumericValue
_         -> Text -> Builder
t Text
x
    Percentage Text
x NumericValue
_     -> Text -> Builder
t Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c Char
'%'
    Dimension Text
x NumericValue
_ Text
u    -> Text -> Builder
t Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
t (Text -> Text -> Text
renderDimensionUnit Text
x Text
u)

    Url Text
x              -> Builder
"url(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
t (Text -> Text
renderUrl Text
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c Char
')'
    Token
BadUrl             -> Builder
"url(()"

    Ident Text
x            -> Text -> Builder
ident Text
x

    AtKeyword Text
x        -> Char -> Builder
c Char
'@' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ident Text
x

    Function Text
x         -> Text -> Builder
ident Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c Char
'('

    Hash HashFlag
HId Text
x           -> Char -> Builder
c Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
ident Text
x
    Hash HashFlag
HUnrestricted Text
x -> Char -> Builder
c Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
t (Text -> Text
renderUnrestrictedHash Text
x)

    Delim Char
'\\'         -> Builder
"\\\n"
    Delim Char
x            -> Char -> Builder
c Char
x
    where c :: Char -> Builder
c = Char -> Builder
TLB.singleton
          t :: Text -> Builder
t = Text -> Builder
TLB.fromText
          q :: Builder
q = Char -> Builder
c Char
'"'
          string :: Text -> Builder
string Text
x = Builder
q Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
t (Text -> Text
renderString Text
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
q
          ident :: Text -> Builder
ident = Text -> Builder
t (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
renderIdent

-- https://www.w3.org/TR/cssom-1/#serialize-a-string

renderString :: Text -> Text
renderString :: Text -> Text
renderString t0 :: Text
t0@(Text Array
_ Int
_ Int
l)
    | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needEscape Text
t0 = Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
go Text
t0 Int
0
    | Bool
otherwise = Text
t0
  where
    needEscape :: Char -> Bool
needEscape Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7F' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
    go :: Text -> Int -> MArray s -> ST s Int
go Text
t Int
d MArray s
dst = case Text -> Maybe (Char, Text)
T.uncons Text
t of
        Maybe (Char, Text)
Nothing -> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
        Just (Char
c, Text
t')
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0' -> do
                Int
d' <- MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d
                -- spec says it should be escaped, but we loose
                -- serialize->tokenize->serialize roundtrip that way
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
            | (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7F' -> do
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
d Char
c
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' -> do
                -- strings are always in double quotes, so '\'' aren't escaped
                MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
'\\'
                MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Char
c
                Text -> Int -> MArray s -> ST s Int
go Text
t' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) MArray s
dst
            | Bool
otherwise -> do
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst Int
d Char
c
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst

renderUrl :: Text -> Text
renderUrl :: Text -> Text
renderUrl t0 :: Text
t0@(Text Array
_ Int
_ Int
l)
    | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needEscape Text
t0 = Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
go Text
t0 Int
0
    | Bool
otherwise = Text
t0
  where
    needEscape :: Char -> Bool
needEscape Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7F' Bool -> Bool -> Bool
|| Char -> Bool
isWhitespace Char
c
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
    go :: Text -> Int -> MArray s -> ST s Int
go Text
t Int
d MArray s
dst = case Text -> Maybe (Char, Text)
T.uncons Text
t of
        Maybe (Char, Text)
Nothing -> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
        Just (Char
c, Text
t')
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0' -> do
                Int
d' <- MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
            | Char -> Bool
needEscape Char
c -> do
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
d Char
c
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
            | Bool
otherwise -> do
                Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst Int
d Char
c
                Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst

renderDimensionUnit :: Text -> Text -> Text
renderDimensionUnit :: Text -> Text -> Text
renderDimensionUnit Text
num t0 :: Text
t0@(Text Array
_ Int
_ Int
l)
    | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isExponent Text
num)
    , Char
c :. Text
t' <- Text
t0
    , Char -> Bool
isExponent Char
c Bool -> Bool -> Bool
&& Text -> Bool
validExp Text
t' =
        Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ \ MArray s
dst -> do
            Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
0 Char
c
            Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
renderUnrestrictedHash' Text
t' Int
d' MArray s
dst
    | Bool
otherwise =
        Text -> Text
renderIdent Text
t0
    where validExp :: Text -> Bool
validExp (Char
s :. Char
d :. Text
_) | (Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') = Char -> Bool
isDigit Char
d
          validExp (Char
d :. Text
_) = Char -> Bool
isDigit Char
d
          validExp Text
_ = Bool
False

renderIdent :: Text -> Text
renderIdent :: Text -> Text
renderIdent Text
"-" = Text
"\\-"
renderIdent t0 :: Text
t0@(Text Array
_ Int
_ Int
l) = case Text
t0 of
    Char
c :. Text
t'
        | Char -> Bool
isDigit Char
c -> Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ \ MArray s
dst -> do
            Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
0 Char
c
            Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
renderUnrestrictedHash' Text
t' Int
d' MArray s
dst
    Char
'-' :. Char
c :. Text
t'
        | Char -> Bool
isDigit Char
c -> Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ \ MArray s
dst -> do
            MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
0 Char
'-'
            Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
1 Char
c
            Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
renderUnrestrictedHash' Text
t' Int
d' MArray s
dst
    Text
_ -> Text -> Text
renderUnrestrictedHash Text
t0

renderUnrestrictedHash :: Text -> Text
renderUnrestrictedHash :: Text -> Text
renderUnrestrictedHash t0 :: Text
t0@(Text Array
_ Int
_ Int
l)
    | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
nameCodePoint) Text
t0 =
        Int -> (forall s. MArray s -> ST s Int) -> Text
withNewA (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) ((forall s. MArray s -> ST s Int) -> Text)
-> (forall s. MArray s -> ST s Int) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
renderUnrestrictedHash' Text
t0 Int
0
    | Bool
otherwise = Text
t0

renderUnrestrictedHash' :: Text -> Int -> A.MArray s -> ST s Int
renderUnrestrictedHash' :: forall {s}. Text -> Int -> MArray s -> ST s Int
renderUnrestrictedHash' = Text -> Int -> MArray s -> ST s Int
forall {s}. Text -> Int -> MArray s -> ST s Int
go
    where go :: Text -> Int -> MArray s -> ST s Int
go Text
t Int
d MArray s
dst = case Text -> Maybe (Char, Text)
T.uncons Text
t of
            Maybe (Char, Text)
Nothing -> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
            Just (Char
c, Text
t')
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0' -> do
                    Int
d' <- MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d
                    Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
                | (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7F' -> do
                    Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
d Char
c
                    Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
                | Char -> Bool
nameCodePoint Char
c -> do
                    Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst Int
d Char
c
                    Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst
                | Bool
otherwise -> do
                    MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
'\\'
                    Int
d' <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Char
c
                    Text -> Int -> MArray s -> ST s Int
go Text
t' Int
d' MArray s
dst

escapeAsCodePoint :: A.MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint :: forall s. MArray s -> Int -> Char -> ST s Int
escapeAsCodePoint MArray s
dst Int
d Char
c = do
    MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
'\\'
    Int
d' <- (Int -> Char -> ST s Int) -> Int -> String -> ST s Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ Int
o Char
x -> MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
o Char
x ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
        (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
c) [])
    MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d' Char
' '
    Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


-- | verify valid escape and consume escaped code point
escapedCodePoint :: Text -> Maybe (Writer' s)
escapedCodePoint :: forall s. Text -> Maybe (Writer' s)
escapedCodePoint Text
t = case Text
t of
    (Char -> Maybe Int
hex -> Just Int
d) :. Text
ts -> Int -> Int -> Text -> Maybe (Writer' s)
forall s. Int -> Int -> Text -> Maybe (Writer' s)
go Int
5 Int
d Text
ts
    Char
'\n' :. Text
_ -> Maybe (Writer' s)
forall a. Maybe a
Nothing
    Char
c :. Text
ts -> Writer' s -> Maybe (Writer' s)
forall a. a -> Maybe a
Just (\ MArray s
dst Int
d -> MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
c ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Text
ts)
    Text
_ -> Maybe (Writer' s)
forall a. Maybe a
Nothing
    where go :: Int -> Int -> Text -> Maybe (Writer' s)
          go :: forall s. Int -> Int -> Text -> Maybe (Writer' s)
go Int
0 Int
acc Text
ts = Int -> Text -> Maybe (MArray s -> Int -> ST s Int, Text)
forall {b} {s}. Int -> b -> Maybe (MArray s -> Int -> ST s Int, b)
ret Int
acc Text
ts
          go Int
n Int
acc Text
ts = case Text
ts of
              (Char -> Maybe Int
hex -> Just Int
d) :. Text
ts' -> Int -> Int -> Text -> Maybe (MArray s -> Int -> ST s Int, Text)
forall s. Int -> Int -> Text -> Maybe (Writer' s)
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) Text
ts'
              Char
c :. Text
ts' | Char -> Bool
isWhitespace Char
c -> Int -> Text -> Maybe (MArray s -> Int -> ST s Int, Text)
forall {b} {s}. Int -> b -> Maybe (MArray s -> Int -> ST s Int, b)
ret Int
acc Text
ts'
              Text
_ -> Int -> Text -> Maybe (MArray s -> Int -> ST s Int, Text)
forall {b} {s}. Int -> b -> Maybe (MArray s -> Int -> ST s Int, b)
ret Int
acc Text
ts
          ret :: Int -> b -> Maybe (MArray s -> Int -> ST s Int, b)
ret Int
c b
ts = (MArray s -> Int -> ST s Int, b)
-> Maybe (MArray s -> Int -> ST s Int, b)
forall a. a -> Maybe a
Just
              (\ MArray s
dst Int
d ->
                  if Int -> Bool
safe Int
c
                  then MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
writeChar MArray s
dst Int
d (Int -> Char
unsafeChr Int
c)
                  else MArray s -> Int -> ST s Int
forall s. MArray s -> Int -> ST s Int
writeFFFD MArray s
dst Int
d
              ,b
ts)

safe :: Int -> Bool
safe :: Int -> Bool
safe Int
x
    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x10FFFF   = Bool
False
    | Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1ff800 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0xd800 = Bool
True
    | Bool
otherwise                = Bool
False -- UTF-16 surrogate code point

hex :: Char -> Maybe Int
hex :: Char -> Maybe Int
hex Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
    | Bool
otherwise            = Maybe Int
forall a. Maybe a
Nothing

{-# INLINE safe #-}
{-# INLINE hex #-}

escapedCodePoint' :: Text -> Maybe (Writer' s)
escapedCodePoint' :: forall s. Text -> Maybe (Writer' s)
escapedCodePoint' (Char
'\\' :. Text
ts) = Text -> Maybe (Writer' s)
forall s. Text -> Maybe (Writer' s)
escapedCodePoint Text
ts
escapedCodePoint' Text
_ = Maybe (Writer' s)
forall a. Maybe a
Nothing

nameStartCodePoint :: Char -> Bool
nameStartCodePoint :: Char -> Bool
nameStartCodePoint Char
c =
    Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0080' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

nameCodePoint :: Char -> Bool
nameCodePoint :: Char -> Bool
nameCodePoint Char
c = Char -> Bool
nameStartCodePoint Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

satisfyOrEscaped :: (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped :: forall s. (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped Char -> Bool
p (Char
c :. Text
ts)
    | Char -> Bool
p Char
c = Writer' s -> Maybe (Writer' s)
forall a. a -> Maybe a
Just (\ MArray s
dst Int
d -> MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
c ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Text
ts)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = Text -> Maybe (Writer' s)
forall s. Text -> Maybe (Writer' s)
escapedCodePoint Text
ts
satisfyOrEscaped Char -> Bool
_ Text
_ = Maybe (Writer' s)
forall a. Maybe a
Nothing

-- | Check if three code points would start an identifier and consume name
parseName :: Text -> Maybe (Writer s)
parseName :: forall s. Text -> Maybe (Writer s)
parseName Text
t = case Text
t of
    Char
'-' :. Text
ts -> Writer' s -> Writer s
forall {s}. Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName' (Writer' s -> Writer s) -> Maybe (Writer' s) -> Maybe (Writer s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> Maybe (Writer' s)
forall s. (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped (\ Char
c -> Char -> Bool
nameStartCodePoint Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
ts
    Text
ts -> Writer' s -> Writer s
forall {s}. Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName (Writer' s -> Writer s) -> Maybe (Writer' s) -> Maybe (Writer s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> Maybe (Writer' s)
forall s. (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped Char -> Bool
nameStartCodePoint Text
ts
    where consumeName' :: Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName' Writer' s
n MArray s
dst Int
d = do
              MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
'-'
              Writer' s -> MArray s -> Int -> ST s (Int, Text)
forall {s}. Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName Writer' s
n MArray s
dst (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


consumeName :: Writer' s -> Writer s
consumeName :: forall {s}. Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName (MArray s -> Int -> ST s Int
w0, Text
ts0) MArray s
dst Int
d0 = do
    Int
d' <- MArray s -> Int -> ST s Int
w0 MArray s
dst Int
d0
    Text -> Int -> ST s (Int, Text)
loop Text
ts0 Int
d'
    where loop :: Text -> Int -> ST s (Int, Text)
loop Text
ts Int
d = case (Char -> Bool) -> Text -> Maybe (MArray s -> Int -> ST s Int, Text)
forall s. (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped Char -> Bool
nameCodePoint Text
ts of
              Just (MArray s -> Int -> ST s Int
w, Text
ts') -> do
                  Int
d' <- MArray s -> Int -> ST s Int
w MArray s
dst Int
d
                  Text -> Int -> ST s (Int, Text)
loop Text
ts' Int
d'
              Maybe (MArray s -> Int -> ST s Int, Text)
Nothing -> (Int, Text) -> ST s (Int, Text)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
d, Text
ts)

{-# INLINE parseName #-}
{-# INLINE consumeName #-}
{-# INLINE satisfyOrEscaped #-}
{-# INLINE escapedCodePoint #-}
{-# INLINE escapedCodePoint' #-}

parseNumericValue :: Text -> Maybe (Text, NumericValue, Text)
parseNumericValue :: Text -> Maybe (Text, NumericValue, Text)
parseNumericValue t0 :: Text
t0@(Text Array
a Int
offs1 Int
_) = case ((Integer -> Integer) -> Text -> Maybe (NumericValue, Text))
-> Text -> Maybe (NumericValue, Text)
forall a b.
Num a =>
((a -> a) -> Text -> Maybe (b, Text)) -> Text -> Maybe (b, Text)
withSign (Integer -> Integer) -> Text -> Maybe (NumericValue, Text)
start Text
t0 of
    Just (NumericValue
nv, ts :: Text
ts@(Text Array
_ Int
offs2 Int
_)) ->
        (Text, NumericValue, Text) -> Maybe (Text, NumericValue, Text)
forall a. a -> Maybe a
Just (Array -> Int -> Int -> Text
Text Array
a Int
offs1 (Int
offs2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offs1), NumericValue
nv, Text
ts)
    Maybe (NumericValue, Text)
Nothing -> Maybe (Text, NumericValue, Text)
forall a. Maybe a
Nothing
    where start :: (Integer -> Integer) -> Text -> Maybe (NumericValue, Text)
start Integer -> Integer
sign Text
t = case Text
t of
              Char
'.' :. (Char -> Maybe Integer
forall a. Enum a => Char -> Maybe a
digit -> Just Integer
d) :. Text
ts -> (Integer -> Integer)
-> IntegerReader -> Int -> Text -> Maybe (NumericValue, Text)
dot Integer -> Integer
sign (Integer -> IntegerReader
startIR Integer
d) (-Int
1) Text
ts
              (Char -> Maybe Integer
forall a. Enum a => Char -> Maybe a
digit -> Just Integer
d) :. Text
ts        -> (Integer -> Integer)
-> IntegerReader -> Text -> Maybe (NumericValue, Text)
digits Integer -> Integer
sign (Integer -> IntegerReader
startIR Integer
d) Text
ts
              Text
_ -> Maybe (NumericValue, Text)
forall a. Maybe a
Nothing
          digits :: (Integer -> Integer)
-> IntegerReader -> Text -> Maybe (NumericValue, Text)
digits Integer -> Integer
sign !IntegerReader
c Text
t = case Text
t of
              Char
'.' :. (Char -> Maybe Integer
forall a. Enum a => Char -> Maybe a
digit -> Just Integer
d) :. Text
ts -> (Integer -> Integer)
-> IntegerReader -> Int -> Text -> Maybe (NumericValue, Text)
dot Integer -> Integer
sign (IntegerReader -> Integer -> IntegerReader
accIR IntegerReader
c Integer
d) (-Int
1) Text
ts
              (Char -> Maybe Integer
forall a. Enum a => Char -> Maybe a
digit -> Just Integer
d) :. Text
ts        -> (Integer -> Integer)
-> IntegerReader -> Text -> Maybe (NumericValue, Text)
digits Integer -> Integer
sign (IntegerReader -> Integer -> IntegerReader
accIR IntegerReader
c Integer
d) Text
ts
              Text
_ -> (NumericValue, Text) -> Maybe (NumericValue, Text)
forall a. a -> Maybe a
Just ((NumericValue, Text) -> Maybe (NumericValue, Text))
-> (NumericValue, Text) -> Maybe (NumericValue, Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Integer -> Int -> Text -> (NumericValue, Text)
expn Bool
True (Integer -> Integer
sign (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ IntegerReader -> Integer
readIR IntegerReader
c) Int
0 Text
t
          dot :: (Integer -> Integer)
-> IntegerReader -> Int -> Text -> Maybe (NumericValue, Text)
dot Integer -> Integer
sign !IntegerReader
c !Int
e Text
t = case Text
t of
              (Char -> Maybe Integer
forall a. Enum a => Char -> Maybe a
digit -> Just Integer
d) :. Text
ts        -> (Integer -> Integer)
-> IntegerReader -> Int -> Text -> Maybe (NumericValue, Text)
dot Integer -> Integer
sign (IntegerReader -> Integer -> IntegerReader
accIR IntegerReader
c Integer
d) (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Text
ts
              Text
_ -> (NumericValue, Text) -> Maybe (NumericValue, Text)
forall a. a -> Maybe a
Just ((NumericValue, Text) -> Maybe (NumericValue, Text))
-> (NumericValue, Text) -> Maybe (NumericValue, Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Integer -> Int -> Text -> (NumericValue, Text)
expn Bool
False (Integer -> Integer
sign (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ IntegerReader -> Integer
readIR IntegerReader
c) Int
e Text
t
          expn :: Bool -> Integer -> Int -> Text -> (NumericValue, Text)
expn Bool
int Integer
c Int
e0 Text
t = case Text
t of
              Char
x :. Text
ts
                  | Char -> Bool
isExponent Char
x
                  , Just (NumericValue, Text)
r <- ((Int -> Int) -> Text -> Maybe (NumericValue, Text))
-> Text -> Maybe (NumericValue, Text)
forall a b.
Num a =>
((a -> a) -> Text -> Maybe (b, Text)) -> Text -> Maybe (b, Text)
withSign (Integer
-> Int -> Int -> (Int -> Int) -> Text -> Maybe (NumericValue, Text)
forall {t}.
(Enum t, Num t) =>
Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
expStart Integer
c Int
e0 Int
0) Text
ts -> (NumericValue, Text)
r
              Text
_   | Bool
int -> (Integer -> NumericValue
NVInteger Integer
c, Text
t)
                  | Bool
otherwise -> (Scientific -> NumericValue
NVNumber (Scientific -> NumericValue) -> Scientific -> NumericValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific Integer
c Int
e0, Text
t)
          expStart :: Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
expStart Integer
c Int
e0 t
e t -> Int
sign Text
t = case Text
t of
              (Char -> Maybe t
forall a. Enum a => Char -> Maybe a
digit -> Just t
d) :. Text
ts -> Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
forall {t}.
(Enum t, Num t) =>
Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
expDigits Integer
c Int
e0 (t
et -> t -> t
forall a. Num a => a -> a -> a
*t
10 t -> t -> t
forall a. Num a => a -> a -> a
+ t
d) t -> Int
sign Text
ts
              Text
_ -> Maybe (NumericValue, Text)
forall a. Maybe a
Nothing
          expDigits :: Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
expDigits Integer
c Int
e0 !t
e t -> Int
sign Text
t = case Text
t of
              (Char -> Maybe t
forall a. Enum a => Char -> Maybe a
digit -> Just t
d) :. Text
ts -> Integer
-> Int -> t -> (t -> Int) -> Text -> Maybe (NumericValue, Text)
expDigits Integer
c Int
e0 (t
et -> t -> t
forall a. Num a => a -> a -> a
*t
10 t -> t -> t
forall a. Num a => a -> a -> a
+ t
d) t -> Int
sign Text
ts
              Text
_ -> (NumericValue, Text) -> Maybe (NumericValue, Text)
forall a. a -> Maybe a
Just (Scientific -> NumericValue
NVNumber (Scientific -> NumericValue) -> Scientific -> NumericValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific Integer
c (t -> Int
sign t
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0), Text
t)
          digit :: Enum a => Char -> Maybe a
          digit :: forall a. Enum a => Char -> Maybe a
digit Char
c
              | Char -> Bool
isDigit Char
c = a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
              | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
          withSign :: Num a => ((a -> a) -> Text -> Maybe (b, Text))
                   -> Text -> Maybe (b, Text)
          withSign :: forall a b.
Num a =>
((a -> a) -> Text -> Maybe (b, Text)) -> Text -> Maybe (b, Text)
withSign (a -> a) -> Text -> Maybe (b, Text)
f Text
t = case Text
t of
              Char
'+' :. Text
ts -> (a -> a) -> Text -> Maybe (b, Text)
f a -> a
forall a. a -> a
id Text
ts
              Char
'-' :. Text
ts -> (a -> a) -> Text -> Maybe (b, Text)
f a -> a
forall a. Num a => a -> a
negate Text
ts
              Text
_ -> (a -> a) -> Text -> Maybe (b, Text)
f a -> a
forall a. a -> a
id Text
t

-- Idea stolen from GHC implementation of `instance Read Integer`
-- http://hackage.haskell.org/package/base-4.11.1.0/docs/src/Text.Read.Lex.html#valInteger
-- A sub-quadratic algorithm for converting digits to Integer.
-- First we collect blocks of `blockDigits`-digit Integers
-- (so we don't do anything besides simple (acc*10+digit) on most inputs).
-- Then we combine them:
-- Pairs of adjacent radix b digits are combined into a single radix b^2 digit.
-- This process is repeated until we are left with a single digit.

blockDigits :: Int
blockDigits :: Int
blockDigits = Int
40

startBase :: Integer
startBase :: Integer
startBase = Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
blockDigits

-- | (num digits in current block, blocks, current block's value)
type IntegerReader = (Int, [Integer], Integer)

startIR :: Integer -> IntegerReader
startIR :: Integer -> IntegerReader
startIR Integer
d = (Int
1, [], Integer
d)

{-# INLINE startIR #-}
{-# INLINE accIR #-}
{-# INLINE readIR #-}

accIR :: IntegerReader -> Integer -> IntegerReader
accIR :: IntegerReader -> Integer -> IntegerReader
accIR (Int
n, [Integer]
blocks, !Integer
cd) Integer
d
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
blockDigits = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, [Integer]
blocks, Integer
cdInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)
    | Bool
otherwise = (Int
1, Integer
cdInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
blocks, Integer
d)

readIR :: IntegerReader -> Integer
readIR :: IntegerReader -> Integer
readIR (Int
_, [], Integer
cd) = Integer
cd
readIR (Int
n, [Integer]
blocks, Integer
cd) =
    Integer -> [Integer] -> Integer
go Integer
startBase ((Integer
cd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
padding)Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
blocks) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
padding
    where padding :: Integer
padding = Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
blockDigitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)
          go :: Integer -> [Integer] -> Integer
          go :: Integer -> [Integer] -> Integer
go Integer
_ [] = Integer
0
          go Integer
_ [Integer
x] = Integer
x
          go Integer
b [Integer]
xs = Integer -> [Integer] -> Integer
go (Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b) (Integer -> [Integer] -> [Integer]
combine Integer
b [Integer]
xs)
          combine :: Integer -> [Integer] -> [Integer]
          combine :: Integer -> [Integer] -> [Integer]
combine Integer
_ [] = []
          combine Integer
_ [Integer
x] = [Integer
x]
          combine Integer
b (Integer
x0:Integer
x1:[Integer]
xs) = Integer
x' Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
combine Integer
b [Integer]
xs
              where !x' :: Integer
x' = Integer
x0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
x1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b

skipComment :: Text -> Text
skipComment :: Text -> Text
skipComment Text
t = case Text
t of
    Char
'*' :. Char
'/' :. Text
ts -> Text
ts
    Char
_ :. Text
ts -> Text -> Text
skipComment Text
ts
    Text
ts -> Text
ts

skipWhitespace :: Text -> Text
skipWhitespace :: Text -> Text
skipWhitespace Text
t = case Text
t of
    Char
c :. Text
ts
        | Char -> Bool
isWhitespace Char
c -> Text -> Text
skipWhitespace Text
ts
        | Bool
otherwise -> Text
t
    Text
ts -> Text
ts

parseTokens :: Text -> [Token]
parseTokens :: Text -> [Token]
parseTokens t0 :: Text
t0@(Text Array
_ Int
_ Int
len) = (Array, [Token]) -> [Token]
forall a b. (a, b) -> b
snd ((Array, [Token]) -> [Token]) -> (Array, [Token]) -> [Token]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MArray s, [Token])) -> (Array, [Token])
forall a. (forall s. ST s (MArray s, a)) -> (Array, a)
A.run2 ((forall s. ST s (MArray s, [Token])) -> (Array, [Token]))
-> (forall s. ST s (MArray s, [Token])) -> (Array, [Token])
forall a b. (a -> b) -> a -> b
$ do
    MArray s
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
    Array
dsta <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst
    let go' :: Token -> Int -> Text -> ST s [Token]
go' !Token
t Int
d Text
tgo = do
            [Token]
ts <- ST s [Token] -> ST s [Token]
forall s a. ST s a -> ST s a
inlineInterleaveST (ST s [Token] -> ST s [Token]) -> ST s [Token] -> ST s [Token]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ST s [Token]
go Int
d Text
tgo
            [Token] -> ST s [Token]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Token
t Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts)
        go :: Int -> Text -> ST s [Token]
go Int
d Text
tgo = case Text
tgo of
            Char
c :. Text
ts | Char -> Bool
isWhitespace Char
c ->
                 Token -> Int -> Text -> ST s [Token]
go' Token
Whitespace Int
d (Text -> Text
skipWhitespace Text
ts)
            Char
'/' :. Char
'*' :. Text
ts -> Int -> Text -> ST s [Token]
go Int
d (Text -> Text
skipComment Text
ts)

            Char
'<' :. Char
'!' :. Char
'-' :. Char
'-' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
CDO Text
ts
            Char
'-' :. Char
'-' :. Char
'>' :. Text
ts ->        Token -> Text -> ST s [Token]
token Token
CDC Text
ts

            Char
',' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
Comma Text
ts
            Char
':' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
Colon Text
ts
            Char
';' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
Semicolon Text
ts
            Char
'(' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
LeftParen Text
ts
            Char
')' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
RightParen Text
ts
            Char
'[' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
LeftSquareBracket Text
ts
            Char
']' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
RightSquareBracket Text
ts
            Char
'{' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
LeftCurlyBracket Text
ts
            Char
'}' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
RightCurlyBracket Text
ts

            Char
'$' :. Char
'=' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
SuffixMatch Text
ts
            Char
'*' :. Char
'=' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
SubstringMatch Text
ts
            Char
'^' :. Char
'=' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
PrefixMatch Text
ts
            Char
'|' :. Char
'=' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
DashMatch Text
ts
            Char
'~' :. Char
'=' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
IncludeMatch Text
ts

            Char
'|' :. Char
'|' :. Text
ts -> Token -> Text -> ST s [Token]
token Token
Column Text
ts

            (Text -> Maybe (Text, NumericValue, Text)
parseNumericValue -> Just (Text
repr, NumericValue
nv, Text
ts))
                | Char
'%' :. Text
ts' <- Text
ts ->
                    Token -> Int -> Text -> ST s [Token]
go' (Text -> NumericValue -> Token
Percentage Text
repr NumericValue
nv) Int
d Text
ts'
                | Just Writer s
u <- Text -> Maybe (Writer s)
forall s. Text -> Maybe (Writer s)
parseName Text
ts -> do
                    (Text
unit, Int
d', Text
ts') <- MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dst Int
d Writer s
u
                    Token -> Int -> Text -> ST s [Token]
go' (Text -> NumericValue -> Text -> Token
Dimension Text
repr NumericValue
nv Text
unit) Int
d' Text
ts'
                | Bool
otherwise ->
                    Token -> Int -> Text -> ST s [Token]
go' (Text -> NumericValue -> Token
Number Text
repr NumericValue
nv) Int
d Text
ts

            -- ident like
            (Text -> Maybe (Writer s)
forall s. Text -> Maybe (Writer s)
parseName -> Just Writer s
n) -> do
                (Text
name, Int
d', Text
ts) <- MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dst Int
d Writer s
n
                if Text -> Bool
isUrl Text
name then
                    -- Special handling of url() functions (they are not really
                    -- functions, they have their own Token type).
                    case Text
ts of
                        Char
'(' :. (Text -> Text
skipWhitespace -> Text
ts') ->
                            case Text
ts' of
                                Char
'"'  :. Text
_ -> Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Function Text
name) Int
d' Text
ts'
                                Char
'\'' :. Text
_ -> Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Function Text
name) Int
d' Text
ts'
                                Text
_ -> Int -> Text -> ST s [Token]
parseUrl Int
d' Text
ts'
                        Text
_ -> Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Ident Text
name) Int
d' Text
ts
                else
                    case Text
ts of
                        Char
'(' :. Text
ts' -> Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Function Text
name) Int
d' Text
ts'
                        Text
_ -> Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Ident Text
name) Int
d' Text
ts

            Char
'"' :. Text
ts -> Char -> Int -> Text -> ST s [Token]
parseString Char
'"' Int
d Text
ts
            Char
'\'' :. Text
ts -> Char -> Int -> Text -> ST s [Token]
parseString Char
'\'' Int
d Text
ts

            Char
'@' :. (Text -> Maybe (Writer s)
forall s. Text -> Maybe (Writer s)
parseName -> Just Writer s
n) -> do
                (Text
name, Int
d', Text
ts) <- MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dst Int
d Writer s
n
                Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
AtKeyword Text
name) Int
d' Text
ts

            Char
'#' :. (Text -> Maybe (Writer s)
forall s. Text -> Maybe (Writer s)
parseName -> Just Writer s
n) -> do
                (Text
name, Int
d', Text
ts) <- MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dst Int
d Writer s
n
                Token -> Int -> Text -> ST s [Token]
go' (HashFlag -> Text -> Token
Hash HashFlag
HId Text
name) Int
d' Text
ts

            Char
'#' :. ((Char -> Bool) -> Text -> Maybe (Writer' s)
forall s. (Char -> Bool) -> Text -> Maybe (Writer' s)
satisfyOrEscaped Char -> Bool
nameCodePoint -> Just Writer' s
n) -> do
                (Text
name, Int
d', Text
ts) <- MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dst Int
d (Writer' s -> Writer s
forall {s}. Writer' s -> MArray s -> Int -> ST s (Int, Text)
consumeName Writer' s
n)
                Token -> Int -> Text -> ST s [Token]
go' (HashFlag -> Text -> Token
Hash HashFlag
HUnrestricted Text
name) Int
d' Text
ts

            Char
c :. Text
ts ->
                Token -> Text -> ST s [Token]
token (Char -> Token
Delim Char
c) Text
ts
            Text
_ -> [Token] -> ST s [Token]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []

            where token :: Token -> Text -> ST s [Token]
token Token
t Text
ts = Token -> Int -> Text -> ST s [Token]
go' Token
t Int
d Text
ts

        isUrl :: Text -> Bool
isUrl t :: Text
t@(Text Array
_ Int
_ Int
3)
            | Char
u :. Char
r :. Char
l :. Text
_ <- Text
t =
                (Char
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'u' Bool -> Bool -> Bool
|| Char
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'U') Bool -> Bool -> Bool
&&
                (Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'r' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'R') Bool -> Bool -> Bool
&&
                (Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'l' Bool -> Bool -> Bool
|| Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'L')
        isUrl Text
_ = Bool
False

        -- https://drafts.csswg.org/css-syntax-3/#consume-string-token
        parseString :: Char -> Int -> Text -> ST s [Token]
parseString Char
endingCodePoint Int
d0 = Int -> Text -> ST s [Token]
string Int
d0
            where string :: Int -> Text -> ST s [Token]
string Int
d Text
t = case Text
t of
                      Char
c :. Text
ts | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
endingCodePoint -> Int -> Text -> ST s [Token]
ret Int
d Text
ts
                      Char
'\\' :. Text
ts
                          | Just (MArray s -> Int -> ST s Int
p, Text
ts') <- Text -> Maybe (Writer' s)
forall s. Text -> Maybe (Writer' s)
escapedCodePoint Text
ts -> do
                              Int
d' <- MArray s -> Int -> ST s Int
p MArray s
dst Int
d
                              Int -> Text -> ST s [Token]
string Int
d' Text
ts'
                          | Char
'\n' :. Text
ts' <- Text
ts ->
                              Int -> Text -> ST s [Token]
string Int
d Text
ts'
                          | Text Array
_ Int
_ Int
0 <- Text
ts ->
                              Int -> Text -> ST s [Token]
string Int
d Text
ts
                      Char
'\n' :. Text
_ -> Token -> Int -> Text -> ST s [Token]
go' Token
BadString Int
d Text
t
                      Char
c :. Text
ts -> do
                          MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
c
                          Int -> Text -> ST s [Token]
string (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
ts
                      Text
_ -> Int -> Text -> ST s [Token]
ret Int
d Text
t
                  ret :: Int -> Text -> ST s [Token]
ret Int
d Text
t = Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
String (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
dsta Int
d0 (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d0)) Int
d Text
t

        -- https://drafts.csswg.org/css-syntax/#consume-url-token
        parseUrl :: Int -> Text -> ST s [Token]
parseUrl Int
d0 Text
tUrl = Int -> Text -> ST s [Token]
url Int
d0 (Text -> Text
skipWhitespace Text
tUrl)
            where ret :: Int -> Text -> ST s [Token]
ret Int
d Text
ts = Token -> Int -> Text -> ST s [Token]
go' (Text -> Token
Url (Array -> Int -> Int -> Text
Text Array
dsta Int
d0 (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d0))) Int
d Text
ts
                  url :: Int -> Text -> ST s [Token]
url Int
d Text
t = case Text
t of
                      Char
')' :. Text
ts -> Int -> Text -> ST s [Token]
ret Int
d Text
ts
                      Char
c :. Text
ts
                          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
                            Bool -> Bool -> Bool
|| Char -> Bool
nonPrintableCodePoint Char
c -> do
                              Int -> Text -> ST s [Token]
badUrl Int
d Text
ts
                          | Char -> Bool
isWhitespace Char
c ->
                              Int -> Text -> ST s [Token]
whitespace Int
d Text
ts
                      Char
'\\' :. Text
ts
                          | Just (MArray s -> Int -> ST s Int
p, Text
ts') <- Text -> Maybe (Writer' s)
forall s. Text -> Maybe (Writer' s)
escapedCodePoint Text
ts -> do
                              Int
d' <- MArray s -> Int -> ST s Int
p MArray s
dst Int
d
                              Int -> Text -> ST s [Token]
url Int
d' Text
ts'
                          | Bool
otherwise ->
                              Int -> Text -> ST s [Token]
badUrl Int
d Text
ts
                      Char
c :. Text
ts -> do
                          MArray s -> Int -> Char -> ST s ()
forall s. MArray s -> Int -> Char -> ST s ()
write MArray s
dst Int
d Char
c
                          Int -> Text -> ST s [Token]
url (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Text
ts
                      Text
_ ->
                          Int -> Text -> ST s [Token]
ret Int
d Text
t
                  whitespace :: Int -> Text -> ST s [Token]
whitespace Int
d Text
t = case Text
t of
                      Char
c :. Text
ts -> do
                          if Char -> Bool
isWhitespace Char
c then
                              Int -> Text -> ST s [Token]
whitespace Int
d Text
ts
                          else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' then
                              Int -> Text -> ST s [Token]
ret Int
d Text
ts
                          else
                              Int -> Text -> ST s [Token]
badUrl Int
d Text
ts
                      Text
_ ->
                          Int -> Text -> ST s [Token]
ret Int
d Text
t
                  badUrl :: Int -> Text -> ST s [Token]
badUrl Int
d Text
t = case Text
t of
                      Char
')' :. Text
ts -> Token -> Int -> Text -> ST s [Token]
go' Token
BadUrl Int
d Text
ts
                      (Text -> Maybe (Writer' Any)
forall s. Text -> Maybe (Writer' s)
escapedCodePoint' -> Just (MArray Any -> Int -> ST Any Int
_, Text
ts)) -> do
                          Int -> Text -> ST s [Token]
badUrl Int
d Text
ts
                      Char
_ :. Text
ts ->
                          Int -> Text -> ST s [Token]
badUrl Int
d Text
ts
                      Text
_ -> Token -> Int -> Text -> ST s [Token]
go' Token
BadUrl Int
d Text
t
        mkText :: A.MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
        mkText :: forall s. MArray s -> Int -> Writer s -> ST s (Text, Int, Text)
mkText MArray s
dest Int
d Writer s
w = do
            (Int
d', Text
ts) <- Writer s
w MArray s
dest Int
d
            (Text, Int, Text) -> ST s (Text, Int, Text)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Int -> Int -> Text
Text Array
dsta Int
d (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d), Int
d', Text
ts)

    [Token]
r <- Int -> Text -> ST s [Token]
go Int
0 Text
t0
    (MArray s, [Token]) -> ST s (MArray s, [Token])
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MArray s
dst, [Token]
r)


isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
'\x0009' = Bool
True
isWhitespace Char
'\x000A' = Bool
True
isWhitespace Char
'\x0020' = Bool
True
isWhitespace Char
_        = Bool
False

nonPrintableCodePoint :: Char -> Bool
nonPrintableCodePoint :: Char -> Bool
nonPrintableCodePoint Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0008' = Bool
True -- NULL through BACKSPACE
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x000B'                  = Bool
True -- LINE TABULATION
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x000E' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x001F' = Bool
True -- SHIFT OUT through INFORMATION SEPARATOR ONE
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x007F'                  = Bool
True -- DELETE
    | Bool
otherwise                      = Bool
False

isExponent :: Char -> Bool
isExponent :: Char -> Bool
isExponent Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E'