diff --git a/benchmark/Benchmark.hs b/benchmark/Benchmark.hs new file mode 100644 --- /dev/null +++ b/benchmark/Benchmark.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad +import Criterion.Main +import System.Directory +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Data.CSS.Syntax.Tokens +import Control.DeepSeq + +-- We're benchmarking speed of processing of 1MB input. +-- So we repeat any input to fill 1MB text. + +fill :: T.Text -> T.Text +fill t = T.take size $ T.replicate (size `div` T.length t + 1) t + where size = 1000000 + +instance NFData NumericValue where rnf x = seq x () +instance NFData Token where rnf x = seq x () + +fileBenchmarks :: NFData b => (a -> b) -> (T.Text -> a) -> IO [Benchmark] +fileBenchmarks f preprocess = do + cwd <- getCurrentDirectory + websites <- drop 2 <$> getDirectoryContents (cwd ++ "/benchmark/fixtures") + forM websites $ \website -> do + files <- drop 2 <$> getDirectoryContents (cwd ++ "/benchmark/fixtures/" ++ website) + benchmarks <- forM files $ \file -> do + body <- T.readFile $ cwd ++ "/benchmark/fixtures/" ++ website ++ "/" ++ file + pure $ bench file $ nf f $ preprocess $ fill body + + pure $ bgroup website benchmarks + +main :: IO () +main = do + tokenizeBenchmarks <- fileBenchmarks tokenize id + serializeBenchmarks <- fileBenchmarks serialize tokenize + serializeTokenizeBenchmarks <- fileBenchmarks (serialize . tokenize) id + + defaultMain [ + bgroup "tokenize" tokenizeBenchmarks, + bgroup "serialize" serializeBenchmarks, + bgroup "serialize/tokenize" serializeTokenizeBenchmarks, + + bgroup "tokenize" + [ tBench' "whitespace" " " + , bench "comment" $ nf tokenize $ "/*" <> fill " " <> "*/" + , numBench 1000 + , numBench 10000 + , numBench 100000 + , numBench 1000000 + , tBench' "aaa.." "a" + , tBench' "esc2" "\\ab" + , tBench' "esc5" "\\abcde" + , bench "url(aaa..)" $ nf tokenize $ "url(" <> fill "a" <> ")" + , bench "url(esc2)" $ nf tokenize $ "url(" <> fill "\\ab" <> ")" + , bench "badUrl(aaa..)"$ nf tokenize $ "url((" <> fill "a" <> ")" + , bench "badUrl(esc2)" $ nf tokenize $ "url((" <> fill "\\ab" <> ")" + , tBench ";" + , tBench "||" + , tBench "a;" + , tBench "1;" + , tBench "a:1;" + , tBench "1234567890;" + , tBench "z-index:1;" + , tBench "#123456 " + , tBench "#FFFFFF " + ], + + bgroup "serialize" + [ sBench "aaa" + , sBench ";" + , sBench "||" + , sBench "1;" + , sBench "1234567890;" + , sBench "a:1;" + , sBench "z-index:1;" + ] + ] + where sBench n = + let t = tokenize $ fill $ T.pack n in + rnf t `seq` bench n $ nf serialize t + tBench n = tBench' n n + tBench' nm n = bench nm $ nf tokenize $ fill $ T.pack n + numBench n = bench ("1e" ++ show n) $ + nf tokenize $ fill $ "1" <> T.replicate n "0" <> " " diff --git a/css-syntax.cabal b/css-syntax.cabal --- a/css-syntax.cabal +++ b/css-syntax.cabal @@ -1,7 +1,7 @@ name: css-syntax -version: 0.0.8 +version: 0.1.0.2 -synopsis: This package implments a parser for the CSS syntax +synopsis: High-performance CSS tokenizer and serializer. description: See https://drafts.csswg.org/css-syntax/ @@ -9,8 +9,8 @@ license: MIT license-file: LICENSE -author: Tomas Carnecky -maintainer: tomas.carnecky@gmail.com +author: Tomas Carnecky , Vladimir Shabanov +maintainer: Tomas Carnecky category: Data @@ -32,18 +32,16 @@ build-depends: base >=4 && <5 - , attoparsec >=0.13 - , bytestring , scientific - , text + , text >=2.0 && <2.1 - ghc-options: -Wall + ghc-options: -Wall -O2 test-suite spec hs-source-dirs: test src default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -Wno-orphans type: exitcode-stdio-1.0 main-is: Test.hs @@ -53,10 +51,30 @@ build-depends: base >=4 && <5 - , attoparsec >=0.13 - , bytestring , scientific , text , hspec + , directory + , QuickCheck + +benchmark benchmark + hs-source-dirs: benchmark src + default-language: Haskell2010 + ghc-options: -Wall -Wno-orphans -O2 -rtsopts + -- -fprof-auto -fprof-cafs + + type: exitcode-stdio-1.0 + main-is: Benchmark.hs + + other-modules: + Data.CSS.Syntax.Tokens + + build-depends: + base >=4 && <5 + , scientific + , text + + , criterion + , deepseq , directory diff --git a/src/Data/CSS/Syntax/Tokens.hs b/src/Data/CSS/Syntax/Tokens.hs --- a/src/Data/CSS/Syntax/Tokens.hs +++ b/src/Data/CSS/Syntax/Tokens.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, PatternSynonyms, ViewPatterns, + BangPatterns, MagicHash #-} module Data.CSS.Syntax.Tokens ( Token(..) @@ -14,9 +15,9 @@ import Control.Applicative import Control.Monad -import Data.Text (Text) import qualified Data.Text as T -import Data.Attoparsec.Text as AP +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB import Data.Monoid import Data.Char import Data.Scientific @@ -24,6 +25,14 @@ 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 @@ -51,15 +60,15 @@ | Column - | String !Char !Text - | BadString !Char !Text + | String !Text + | BadString | Number !Text !NumericValue | Percentage !Text !NumericValue | Dimension !Text !NumericValue !Unit | Url !Text - | BadUrl !Text + | BadUrl | Ident !Text @@ -75,8 +84,8 @@ data NumericValue - = NVInteger !Scientific - | NVNumber !Scientific + = NVInteger !Integer -- ^ number without dot '.' or exponent 'e' + | NVNumber !Scientific -- ^ number with dot '.' or exponent 'e' deriving (Show, Eq) data HashFlag = HId | HUnrestricted @@ -94,8 +103,8 @@ -- -- https://drafts.csswg.org/css-syntax/#tokenization -tokenize :: Text -> Either String [Token] -tokenize = parseOnly (many' parseToken) . preprocessInputStream +tokenize :: Text -> [Token] +tokenize = parseTokens . preprocessInputStream @@ -105,409 +114,719 @@ -- https://drafts.csswg.org/css-syntax/#input-preprocessing preprocessInputStream :: Text -> Text -preprocessInputStream = T.pack . f . T.unpack - where - f [] = [] +preprocessInputStream t0@(Text _ _ len) = withNewA (len*3) $ \ dst -> do + let go t d = case t of + '\x0D' :. '\x0A' :. t' -> + put '\x0A' t' + '\x0D' :. t' -> + put '\x0A' t' + '\x0C' :. t' -> + put '\x0A' t' + '\x00' :. t' -> do + d' <- writeFFFD dst d + go t' d' + c :. t' -> + put c t' + _ -> + return d + where put x t' = do + write dst d x + go t' (d + 1) + go t0 0 - f ('\x000D':'\x000A':r) = '\x000A' : f r - f ('\x000D':r) = '\x000A' : f r - f ('\x000C':r) = '\x000A' : f r +-- Low level utilities +------------------------------------------------------------------------------- - f ('\x0000':r) = '\xFFFD' : f r +pattern (:.) :: Char -> Text -> Text +pattern x :. xs <- (uncons -> Just (x, xs)) - f (x:r) = x : f r +infixr 5 :. +-- | uncons first Word8 from Text without trying to decode UTF-8 sequence +uncons :: Text -> Maybe (Char, Text) +uncons (Text src offs len) + | len <= 0 = Nothing + | otherwise = + Just (w2c (A.unsafeIndex src offs), Text src (offs+1) (len-1)) +{-# INLINE uncons #-} +-- | write replacement character +writeFFFD :: A.MArray s -> Int -> ST s Int +writeFFFD dst d = writeChar dst d '\xFFFD' --- Serialization -------------------------------------------------------------------------------- +-- | write 8bit character +write :: A.MArray s -> Int -> Char -> ST s () +write dst d x = A.unsafeWrite dst d (c2w 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 marr i c = case utf8Length c of + 1 -> do + let n0 = intToWord8 (ord c) + A.unsafeWrite marr i n0 + return (i+1) + 2 -> do + let (n0, n1) = ord2 c + A.unsafeWrite marr i n0 + A.unsafeWrite marr (i+1) n1 + return (i+2) + 3 -> do + let (n0, n1, n2) = ord3 c + A.unsafeWrite marr i n0 + A.unsafeWrite marr (i+1) n1 + A.unsafeWrite marr (i+2) n2 + return (i+3) + _ -> do + let (n0, n1, n2, n3) = ord4 c + A.unsafeWrite marr i n0 + A.unsafeWrite marr (i+1) n1 + A.unsafeWrite marr (i+2) n2 + A.unsafeWrite marr (i+3) n3 + return (i+4) +{-# INLINE writeChar #-} --- | Serialize a list of 'Token's back into 'Text'. Round-tripping is not --- guaranteed to be identity. The tokenization step drops some information --- from the source. --- --- https://drafts.csswg.org/css-syntax/#serialization +utf8Length :: Char -> Int +utf8Length (C# c) = I# ((1# +# geChar# c (chr# 0x80#)) +# (geChar# c (chr# 0x800#) +# geChar# c (chr# 0x10000#))) +{-# INLINE utf8Length #-} -serialize :: [Token] -> Text -serialize = mconcat . map renderToken +ord2 :: Char -> (Word8,Word8) +ord2 c = (x1,x2) + where + n = ord c + x1 = intToWord8 $ (n `shiftR` 6) + 0xC0 + x2 = intToWord8 $ (n .&. 0x3F) + 0x80 +{-# INLINE ord2 #-} +ord3 :: Char -> (Word8,Word8,Word8) +ord3 c = (x1,x2,x3) + where + n = ord c + x1 = intToWord8 $ (n `shiftR` 12) + 0xE0 + x2 = intToWord8 $ ((n `shiftR` 6) .&. 0x3F) + 0x80 + x3 = intToWord8 $ (n .&. 0x3F) + 0x80 +{-# INLINE ord3 #-} -renderToken :: Token -> Text -renderToken (Whitespace) = " " +ord4 :: Char -> (Word8,Word8,Word8,Word8) +ord4 c = (x1,x2,x3,x4) + where + n = ord c + x1 = intToWord8 $ (n `shiftR` 18) + 0xF0 + x2 = intToWord8 $ ((n `shiftR` 12) .&. 0x3F) + 0x80 + x3 = intToWord8 $ ((n `shiftR` 6) .&. 0x3F) + 0x80 + x4 = intToWord8 $ (n .&. 0x3F) + 0x80 +{-# INLINE ord4 #-} -renderToken (CDO) = "" +intToWord8 :: Int -> Word8 +intToWord8 = fromIntegral -renderToken (Comma) = "," -renderToken (Colon) = ":" -renderToken (Semicolon) = ";" -renderToken (LeftParen) = "(" -renderToken (RightParen) = ")" -renderToken (LeftSquareBracket) = "[" -renderToken (RightSquareBracket) = "]" -renderToken (LeftCurlyBracket) = "{" -renderToken (RightCurlyBracket) = "}" +type Writer' s = (A.MArray s -> Int -> ST s Int, Text) +type Writer s = A.MArray s -> Int -> ST s (Int, Text) -renderToken (SuffixMatch) = "$=" -renderToken (SubstringMatch) = "*=" -renderToken (PrefixMatch) = "^=" -renderToken (DashMatch) = "|=" -renderToken (IncludeMatch) = "~=" +-- | no-op for convenient pattern matching +w2c :: Word8 -> Char +w2c = unsafeChr . fromIntegral +{-# INLINE w2c #-} -renderToken (Column) = "||" +c2w :: Char -> Word8 +c2w = fromIntegral . ord +{-# INLINE c2w #-} -renderToken (String d x) = T.singleton d <> renderString x <> T.singleton d -renderToken (BadString d x) = T.singleton d <> renderString x <> T.singleton d +withNewA :: Int -> (forall s . A.MArray s -> ST s Int) -> Text +withNewA len act = Text a 0 l + where (a, l) = A.run2 $ do + dst <- A.new len + dLen <- act dst + return (dst, dLen) -renderToken (Number x _) = x -renderToken (Percentage x _) = x <> "%" -renderToken (Dimension x _ u) = x <> u -renderToken (Url x) = "url(" <> x <> ")" -renderToken (BadUrl x) = "url(" <> x <> ")" +-- Serialization +------------------------------------------------------------------------------- -renderToken (Ident x) = x -renderToken (AtKeyword x) = "@" <> x +-- | 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 -renderToken (Function x) = x <> "(" -renderToken (Hash _ x) = "#" <> x +serialize :: [Token] -> Text +serialize = TL.toStrict . TLB.toLazyText . go + where go [] = "" + go [Delim '\\'] = "\\" -- do not add newline in last token + go [x] = renderToken x + go (x:xs@(y:_)) + | needComment x y = renderToken x <> "/**/" <> go xs + | otherwise = renderToken x <> go xs -renderToken (Delim x) = T.singleton x +{-# INLINE renderToken #-} +{-# INLINE needComment #-} +needComment :: Token -> Token -> Bool +needComment a CDC = case 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 '!' -> True + Delim '@' -> True + Delim '#' -> True + Delim '-' -> True + Number {} -> True + Dimension {} -> True + Ident _ -> True + AtKeyword _ -> True + Function _ -> True + Hash {} -> True + _ -> False +needComment a b = case a of + Whitespace -> b == Whitespace + Ident "--" -> b == Delim '>' -- Looks like a CDC + Ident _ -> idn || b == CDC || b == LeftParen + AtKeyword _ -> idn || b == CDC + Hash {} -> idn || b == CDC + Dimension {} -> idn || b == CDC + Delim '#' -> idn + Delim '-' -> idn + Number {} -> i || num || b == Delim '%' + Delim '@' -> i || b == Delim '-' + Delim '.' -> num + Delim '+' -> num + Delim '/' -> b == Delim '*' || b == SubstringMatch + Delim '|' -> b == Delim '=' + || b == Delim '|' || b == Column || b == DashMatch + Delim '$' -> b == Delim '=' + Delim '*' -> b == Delim '=' + Delim '^' -> b == Delim '=' + Delim '~' -> b == Delim '=' + _ -> False + where idn = i || b == Delim '-' || num + i = case b of + Ident _ -> True + Function _ -> True + Url _ -> True + BadUrl -> True + _ -> False + num = case b of + Number {} -> True + Percentage {} -> True + Dimension {} -> True + _ -> False -renderString :: Text -> Text -renderString = T.pack . concatMap f . T.unpack - where - nonPrintableCodePoint c - | c >= '\x0000' && c <= '\x0008' = True -- NULL through BACKSPACE - | c == '\x000B' = True -- LINE TABULATION - | c >= '\x000E' && c <= '\x001F' = True -- SHIFT OUT through INFORMATION SEPARATOR ONE - | c == '\x007F' = True -- DELETE - | otherwise = False +renderToken :: Token -> TLB.Builder +renderToken token = case token of + Whitespace -> c ' ' - nonASCIICodePoint c = c >= '\x0080' -- control + CDO -> "" - f c = if nonPrintableCodePoint c || nonASCIICodePoint c - then "\\" <> showHex (ord c) "" - else [c] + Comma -> c ',' + Colon -> c ':' + Semicolon -> c ';' + LeftParen -> c '(' + RightParen -> c ')' + LeftSquareBracket -> c '[' + RightSquareBracket -> c ']' + LeftCurlyBracket -> c '{' + RightCurlyBracket -> c '}' -parseComment :: Parser () -parseComment = do - void $ AP.string "/*" - void $ AP.manyTill' AP.anyChar (void (AP.string "*/") <|> AP.endOfInput) + SuffixMatch -> "$=" + SubstringMatch -> "*=" + PrefixMatch -> "^=" + DashMatch -> "|=" + IncludeMatch -> "~=" -parseWhitespace :: Parser Token -parseWhitespace = do - void $ AP.takeWhile1 isWhitespace - return Whitespace + Column -> "||" -parseChar :: Token -> Char -> Parser Token -parseChar t c = do - _ <- AP.char c - return t + String x -> string x + BadString -> "\"\n" -parseStr :: Token -> Text -> Parser Token -parseStr t str = AP.string str *> return t + Number x _ -> t x + Percentage x _ -> t x <> c '%' + Dimension x _ u -> t x <> t (renderDimensionUnit x u) -escapedCodePoint :: Parser Char -escapedCodePoint = do - mbChar <- AP.peekChar - case mbChar of - Nothing -> return $ '\xFFFD' - Just ch -> do - if isHexChar ch - then do - (t, _) <- AP.runScanner [] f - case unhex (T.unpack t) of - Nothing -> fail $ "escapedCodePoint: unable to parse hex " ++ (T.unpack t) - Just cp -> do - AP.peekChar >>= \c -> case c of - Just nc -> if isWhitespace nc then void AP.anyChar else return () - _ -> return () - return $ if cp == 0 || cp > 0x10FFFF - then chr 0xFFFD - else chr cp - else do - if ch == '\n' - then fail "A newline" - else AP.anyChar >> return ch + Url x -> "url(" <> t (renderUrl x) <> c ')' + BadUrl -> "url(()" - where - f :: String -> Char -> Maybe String - f acc c = - if length acc < 6 && isHexChar c - then Just $ c:acc - else Nothing + Ident x -> ident x + AtKeyword x -> c '@' <> ident x -nextInputCodePoint :: Parser Char -nextInputCodePoint = escapedCodePoint' <|> AP.anyChar + Function x -> ident x <> c '(' + Hash HId x -> c '#' <> ident x + Hash HUnrestricted x -> c '#' <> t (renderUnrestrictedHash x) -whenNext :: Char -> a -> Parser a -whenNext c a = do - mbChar <- AP.peekChar - if mbChar == Just c - then return a - else fail "whenNext" + Delim '\\' -> "\\\n" + Delim x -> c x + where c = TLB.singleton + t = TLB.fromText + q = c '"' + string x = q <> t (renderString x) <> q + ident = t . renderIdent --- 4.3.4. Consume a string token -parseString :: Char -> Parser Token -parseString endingCodePoint = do - _ <- AP.char endingCodePoint - go [] +-- https://www.w3.org/TR/cssom-1/#serialize-a-string +renderString :: Text -> Text +renderString t0@(Text _ _ l) + | T.any needEscape t0 = withNewA (l*8) $ go t0 0 + | otherwise = t0 where - go acc = choice - [ (AP.endOfInput <|> void (AP.char endingCodePoint)) *> return (String endingCodePoint $ fromAcc acc) - , AP.string "\\\n" *> go acc - , whenNext '\n' (BadString endingCodePoint $ fromAcc acc) - , nextInputCodePoint >>= \ch -> go (ch:acc) - ] + needEscape c = c <= '\x1F' || c == '\x7F' || c == '"' || c == '\\' + go t d dst = case T.uncons t of + Nothing -> return d + Just (c, t') + | c == '\x0' -> do + d' <- writeFFFD dst d + -- spec says it should be escaped, but we loose + -- serialize->tokenize->serialize roundtrip that way + go t' d' dst + | (c >= '\x1' && c <= '\x1F') || c == '\x7F' -> do + d' <- escapeAsCodePoint dst d c + go t' d' dst + | c == '"' || c == '\\' -> do + -- strings are always in double quotes, so '\'' aren't escaped + write dst d '\\' + write dst (d+1) c + go t' (d+2) dst + | otherwise -> do + d' <- writeChar dst d c + go t' d' dst -fromAcc :: [Char] -> Text -fromAcc = T.pack . reverse +renderUrl :: Text -> Text +renderUrl t0@(Text _ _ l) + | T.any needEscape t0 = withNewA (l*8) $ go t0 0 + | otherwise = t0 + where + needEscape c = c <= '\x1F' || c == '\x7F' || isWhitespace c + || c == '\\' || c == ')' || c == '"' || c == '\'' || c == '(' + go t d dst = case T.uncons t of + Nothing -> return d + Just (c, t') + | c == '\x0' -> do + d' <- writeFFFD dst d + go t' d' dst + | needEscape c -> do + d' <- escapeAsCodePoint dst d c + go t' d' dst + | otherwise -> do + d' <- writeChar dst d c + go t' d' dst -parseHash :: Parser Token -parseHash = do - _ <- AP.char '#' - name <- parseName - return $ Hash HId name +renderDimensionUnit :: Text -> Text -> Text +renderDimensionUnit num t0@(Text _ _ l) + | not (T.any isExponent num) + , c :. t' <- t0 + , isExponent c && validExp t' = + withNewA (l*8) $ \ dst -> do + d' <- escapeAsCodePoint dst 0 c + renderUnrestrictedHash' t' d' dst + | otherwise = + renderIdent t0 + where validExp (s :. d :. _) | (s == '+' || s == '-') = isDigit d + validExp (d :. _) = isDigit d + validExp _ = False -isNameStartCodePoint :: Char -> Bool -isNameStartCodePoint c = isLetter c || c >= '\x0080' || c == '_' +renderIdent :: Text -> Text +renderIdent "-" = "\\-" +renderIdent t0@(Text _ _ l) = case t0 of + c :. t' + | isDigit c -> withNewA (l*8) $ \ dst -> do + d' <- escapeAsCodePoint dst 0 c + renderUnrestrictedHash' t' d' dst + '-' :. c :. t' + | isDigit c -> withNewA (l*8) $ \ dst -> do + write dst 0 '-' + d' <- escapeAsCodePoint dst 1 c + renderUnrestrictedHash' t' d' dst + _ -> renderUnrestrictedHash t0 -isNameCodePoint :: Char -> Bool -isNameCodePoint c = isNameStartCodePoint c || isDigit c || c == '-' +renderUnrestrictedHash :: Text -> Text +renderUnrestrictedHash t0@(Text _ _ l) + | T.any (not . nameCodePoint) t0 = + withNewA (l*8) $ renderUnrestrictedHash' t0 0 + | otherwise = t0 -parseNumeric :: Parser Token -parseNumeric = do - (repr, nv) <- parseNumericValue - dimNum repr nv <|> pctNum repr nv <|> return (Number repr nv) - where - dimNum repr nv = do - unit <- parseName - return $ Dimension repr nv unit - pctNum repr nv = do - _ <- AP.char '%' - return $ Percentage repr nv +renderUnrestrictedHash' :: Text -> Int -> A.MArray s -> ST s Int +renderUnrestrictedHash' = go + where go t d dst = case T.uncons t of + Nothing -> return d + Just (c, t') + | c == '\x0' -> do + d' <- writeFFFD dst d + go t' d' dst + | (c >= '\x1' && c <= '\x1F') || c == '\x7F' -> do + d' <- escapeAsCodePoint dst d c + go t' d' dst + | nameCodePoint c -> do + d' <- writeChar dst d c + go t' d' dst + | otherwise -> do + write dst d '\\' + d' <- writeChar dst (d+1) c + go t' d' dst -nameCodePoint :: Parser Char -nameCodePoint = AP.satisfy isNameCodePoint +escapeAsCodePoint :: A.MArray s -> Int -> Char -> ST s Int +escapeAsCodePoint dst d c = do + write dst d '\\' + d' <- foldM (\ o x -> write dst o x >> return (o+1)) + (d+1) (showHex (ord c) []) + write dst d' ' ' + return (d' + 1) -escapedCodePoint' :: Parser Char -escapedCodePoint' = do - _ <- AP.char '\\' - escapedCodePoint -parseName :: Parser Text -parseName = do - chars <- AP.many1' $ - nameCodePoint <|> escapedCodePoint' +-- | verify valid escape and consume escaped code point +escapedCodePoint :: Text -> Maybe (Writer' s) +escapedCodePoint t = case t of + (hex -> Just d) :. ts -> go 5 d ts + '\n' :. _ -> Nothing + c :. ts -> Just (\ dst d -> write dst d c >> return (d+1), ts) + _ -> Nothing + where go :: Int -> Int -> Text -> Maybe (Writer' s) + go 0 acc ts = ret acc ts + go n acc ts = case ts of + (hex -> Just d) :. ts' -> go (n-1) (acc*16 + d) ts' + c :. ts' | isWhitespace c -> ret acc ts' + _ -> ret acc ts + ret c ts = Just + (\ dst d -> + if safe c + then writeChar dst d (unsafeChr c) + else writeFFFD dst d + ,ts) - case chars of - '-':xs -> case xs of - _:_ -> return $ T.pack chars - _ -> fail "parseName: Not a valid name start" - _ -> return $ T.pack chars +safe :: Int -> Bool +safe x + | x == 0 || x > 0x10FFFF = False + | x .&. 0x1ff800 /= 0xd800 = True + | otherwise = False -- UTF-16 surrogate code point +hex :: Char -> Maybe Int +hex c + | c >= '0' && c <= '9' = Just (ord c - ord '0') + | c >= 'a' && c <= 'f' = Just (ord c - ord 'a' + 10) + | c >= 'A' && c <= 'F' = Just (ord c - ord 'A' + 10) + | otherwise = Nothing -parseSign :: Parser (Text, Int) -parseSign = do - mbChar <- AP.peekChar - case mbChar of - Just '+' -> AP.anyChar >> return ("+", 1) - Just '-' -> AP.anyChar >> return ("-", (-1)) - _ -> return ("", 1) +{-# INLINE safe #-} +{-# INLINE hex #-} -parseNumericValue :: Parser (Text, NumericValue) -parseNumericValue = do - -- Sign - (sS, s) <- parseSign +escapedCodePoint' :: Text -> Maybe (Writer' s) +escapedCodePoint' ('\\' :. ts) = escapedCodePoint ts +escapedCodePoint' _ = Nothing - -- Digits before the decimal dot. They are optional (".1em"). - (iS, i) <- do - digits <- AP.takeWhile isDigit - return $ if (T.null digits) - then ("", 0) - else (digits, read $ T.unpack digits) +nameStartCodePoint :: Char -> Bool +nameStartCodePoint c = + isAsciiLower c || isAsciiUpper c || c >= '\x0080' || c == '_' - -- Decimal dot and digits after it. If the decimal dot is there then it - -- MUST be followed by one or more digits. This is not allowed: "1.". - (fS, f, fB) <- option ("", 0, False) $ do - _ <- AP.char '.' - digits <- AP.takeWhile1 isDigit - return ("." <> digits, read $ T.unpack digits, True) +nameCodePoint :: Char -> Bool +nameCodePoint c = nameStartCodePoint c || isDigit c || c == '-' - -- Exponent (with optional sign). - (tS, t, eS, e, eB) <- option ("", 1, "", 0, False) $ do - e <- AP.char 'E' <|> AP.char 'e' - (tS, t) <- parseSign - eS <- AP.takeWhile1 isDigit +satisfyOrEscaped :: (Char -> Bool) -> Text -> Maybe (Writer' s) +satisfyOrEscaped p (c :. ts) + | p c = Just (\ dst d -> write dst d c >> return (d+1), ts) + | c == '\\' = escapedCodePoint ts +satisfyOrEscaped _ _ = Nothing - return (T.singleton e <> tS, t, eS, read $ T.unpack eS, True) +-- | Check if three code points would start an identifier and consume name +parseName :: Text -> Maybe (Writer s) +parseName t = case t of + '-' :. ts -> consumeName' <$> satisfyOrEscaped (\ c -> nameStartCodePoint c || c == '-') ts + ts -> consumeName <$> satisfyOrEscaped nameStartCodePoint ts + where consumeName' n dst d = do + write dst d '-' + consumeName n dst (d + 1) - let repr = sS<>iS<>fS<>tS<>eS - if T.null repr || repr == "-" || repr == "+" || T.head repr == 'e' || T.head repr == 'E' - then fail "parseNumericValue: no parse" - else do - let v = fromIntegral s * (i + f*10^^(-(T.length fS - 1))) * 10^^(t*e) - return $ if fB || eB - then (repr, NVNumber v) - else (repr, NVInteger v) +consumeName :: Writer' s -> Writer s +consumeName (w0, ts0) dst d0 = do + d' <- w0 dst d0 + loop ts0 d' + where loop ts d = case satisfyOrEscaped nameCodePoint ts of + Just (w, ts') -> do + d' <- w dst d + loop ts' d' + Nothing -> return (d, ts) -parseUrl :: Parser Token -parseUrl = do - _ <- AP.takeWhile isWhitespace - go [] +{-# INLINE parseName #-} +{-# INLINE consumeName #-} +{-# INLINE satisfyOrEscaped #-} +{-# INLINE escapedCodePoint #-} +{-# INLINE escapedCodePoint' #-} - where - endOfUrl acc = (AP.endOfInput <|> void (AP.char ')')) *> return (Url $ fromAcc acc) +parseNumericValue :: Text -> Maybe (Text, NumericValue, Text) +parseNumericValue t0@(Text a offs1 _) = case withSign start t0 of + Just (nv, ts@(Text _ offs2 _)) -> + Just (Text a offs1 (offs2 - offs1), nv, ts) + Nothing -> Nothing + where start sign t = case t of + '.' :. (digit -> Just d) :. ts -> dot sign (startIR d) (-1) ts + (digit -> Just d) :. ts -> digits sign (startIR d) ts + _ -> Nothing + digits sign !c t = case t of + '.' :. (digit -> Just d) :. ts -> dot sign (accIR c d) (-1) ts + (digit -> Just d) :. ts -> digits sign (accIR c d) ts + _ -> Just $ expn True (sign $ readIR c) 0 t + dot sign !c !e t = case t of + (digit -> Just d) :. ts -> dot sign (accIR c d) (e-1) ts + _ -> Just $ expn False (sign $ readIR c) e t + expn int c e0 t = case t of + x :. ts + | isExponent x + , Just r <- withSign (expStart c e0 0) ts -> r + _ | int -> (NVInteger c, t) + | otherwise -> (NVNumber $ scientific c e0, t) + expStart c e0 e sign t = case t of + (digit -> Just d) :. ts -> expDigits c e0 (e*10 + d) sign ts + _ -> Nothing + expDigits c e0 !e sign t = case t of + (digit -> Just d) :. ts -> expDigits c e0 (e*10 + d) sign ts + _ -> Just (NVNumber $ scientific c (sign e + e0), t) + digit :: Enum a => Char -> Maybe a + digit c + | isDigit c = Just (toEnum $ ord c - ord '0') + | otherwise = Nothing + withSign :: Num a => ((a -> a) -> Text -> Maybe (b, Text)) + -> Text -> Maybe (b, Text) + withSign f t = case t of + '+' :. ts -> f id ts + '-' :. ts -> f negate ts + _ -> f id t - go acc = choice - [ endOfUrl acc - , (AP.char '"' <|> AP.char '\'' <|> AP.char '(') >>= \ch -> badUrl (ch:acc) - , AP.string "\\\n" *> badUrl ('\n':'\\':acc) - , AP.takeWhile1 isWhitespace >>= \c -> (endOfUrl acc <|> badUrl (reverse (T.unpack c) ++ acc)) - , nextInputCodePoint >>= \ch -> go (ch:acc) - ] +-- 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. - badUrl acc = choice - [ (AP.endOfInput <|> void (AP.char ')')) *> return (BadUrl $ fromAcc acc) - , nextInputCodePoint >>= \ch -> badUrl (ch:acc) - ] +blockDigits :: Int +blockDigits = 40 +startBase :: Integer +startBase = 10^blockDigits -parseIdentLike :: Parser Token -parseIdentLike = do - name <- parseName - choice - [ do - -- Special handling of url() functions (they are not really - -- functions, they have their own Token type). - guard $ T.isPrefixOf "url" (T.map toLower name) +-- | (num digits in current block, blocks, current block's value) +type IntegerReader = (Int, [Integer], Integer) - void $ AP.char '(' - void $ AP.takeWhile isWhitespace +startIR :: Integer -> IntegerReader +startIR d = (1, [], d) - whenNext '"' (Function name) <|> whenNext '\'' (Function name) <|> parseUrl +{-# INLINE startIR #-} +{-# INLINE accIR #-} +{-# INLINE readIR #-} - , AP.char '(' *> return (Function name) - , return (Ident name) - ] +accIR :: IntegerReader -> Integer -> IntegerReader +accIR (n, blocks, !cd) d + | n < blockDigits = (n+1, blocks, cd*10 + d) + | otherwise = (1, cd:blocks, d) +readIR :: IntegerReader -> Integer +readIR (_, [], cd) = cd +readIR (n, blocks, cd) = + go startBase ((cd * padding):blocks) `div` padding + where padding = 10^(blockDigits-n) + go :: Integer -> [Integer] -> Integer + go _ [] = 0 + go _ [x] = x + go b xs = go (b*b) (combine b xs) + combine :: Integer -> [Integer] -> [Integer] + combine _ [] = [] + combine _ [x] = [x] + combine b (x0:x1:xs) = x' : combine b xs + where !x' = x0 + x1*b -parseEscapedIdentLike :: Parser Token -parseEscapedIdentLike = do - mbChar <- AP.peekChar - case mbChar of - Just '\\' -> parseIdentLike <|> (AP.anyChar >> return (Delim '\\')) - _ -> fail "parseEscapedIdentLike: Does not start with an escape code" +skipComment :: Text -> Text +skipComment t = case t of + '*' :. '/' :. ts -> ts + _ :. ts -> skipComment ts + ts -> ts -parseAtKeyword :: Parser Token -parseAtKeyword = do - _ <- AP.char '@' - name <- parseName - return $ AtKeyword name +skipWhitespace :: Text -> Text +skipWhitespace t = case t of + c :. ts + | isWhitespace c -> skipWhitespace ts + | otherwise -> t + ts -> ts +parseTokens :: Text -> [Token] +parseTokens t0@(Text _ _ len) = snd $ A.run2 $ do + dst <- A.new len + dsta <- A.unsafeFreeze dst + let go' !t d tgo = do + ts <- inlineInterleaveST $ go d tgo + return (t : ts) + go d tgo = case tgo of + c :. ts | isWhitespace c -> + go' Whitespace d (skipWhitespace ts) + '/' :. '*' :. ts -> go d (skipComment ts) -parseToken :: Parser Token -parseToken = AP.many' parseComment *> choice - [ parseWhitespace + '<' :. '!' :. '-' :. '-' :. ts -> token CDO ts + '-' :. '-' :. '>' :. ts -> token CDC ts - , AP.string "" *> return CDC + ',' :. ts -> token Comma ts + ':' :. ts -> token Colon ts + ';' :. ts -> token Semicolon ts + '(' :. ts -> token LeftParen ts + ')' :. ts -> token RightParen ts + '[' :. ts -> token LeftSquareBracket ts + ']' :. ts -> token RightSquareBracket ts + '{' :. ts -> token LeftCurlyBracket ts + '}' :. ts -> token RightCurlyBracket ts - , parseChar Comma ',' - , parseChar Colon ':' - , parseChar Semicolon ';' - , parseChar LeftParen '(' - , parseChar RightParen ')' - , parseChar LeftSquareBracket '[' - , parseChar RightSquareBracket ']' - , parseChar LeftCurlyBracket '{' - , parseChar RightCurlyBracket '}' + '$' :. '=' :. ts -> token SuffixMatch ts + '*' :. '=' :. ts -> token SubstringMatch ts + '^' :. '=' :. ts -> token PrefixMatch ts + '|' :. '=' :. ts -> token DashMatch ts + '~' :. '=' :. ts -> token IncludeMatch ts - , parseStr SuffixMatch "$=" - , parseStr SubstringMatch "*=" - , parseStr PrefixMatch "^=" - , parseStr DashMatch "|=" - , parseStr IncludeMatch "~=" + '|' :. '|' :. ts -> token Column ts - , parseStr Column "||" + (parseNumericValue -> Just (repr, nv, ts)) + | '%' :. ts' <- ts -> + go' (Percentage repr nv) d ts' + | Just u <- parseName ts -> do + (unit, d', ts') <- mkText dst d u + go' (Dimension repr nv unit) d' ts' + | otherwise -> + go' (Number repr nv) d ts - , parseNumeric + -- ident like + (parseName -> Just n) -> do + (name, d', ts) <- mkText dst d n + if isUrl name then + -- Special handling of url() functions (they are not really + -- functions, they have their own Token type). + case ts of + '(' :. (skipWhitespace -> ts') -> + case ts' of + '"' :. _ -> go' (Function name) d' ts' + '\'' :. _ -> go' (Function name) d' ts' + _ -> parseUrl d' ts' + _ -> go' (Ident name) d' ts + else + case ts of + '(' :. ts' -> go' (Function name) d' ts' + _ -> go' (Ident name) d' ts - , parseEscapedIdentLike - , parseIdentLike - , parseHash + '"' :. ts -> parseString '"' d ts + '\'' :. ts -> parseString '\'' d ts - , parseString '"' - , parseString '\'' + '@' :. (parseName -> Just n) -> do + (name, d', ts) <- mkText dst d n + go' (AtKeyword name) d' ts - , parseAtKeyword + '#' :. (parseName -> Just n) -> do + (name, d', ts) <- mkText dst d n + go' (Hash HId name) d' ts - , AP.anyChar >>= return . Delim - ] "token" + '#' :. (satisfyOrEscaped nameCodePoint -> Just n) -> do + (name, d', ts) <- mkText dst d (consumeName n) + go' (Hash HUnrestricted name) d' ts + c :. ts -> + token (Delim c) ts + _ -> return [] + where token t ts = go' t d ts -isWhitespace :: Char -> Bool -isWhitespace '\x0009' = True -isWhitespace '\x000A' = True -isWhitespace '\x0020' = True -isWhitespace _ = False + isUrl t@(Text _ _ 3) + | u :. r :. l :. _ <- t = + (u == 'u' || u == 'U') && + (r == 'r' || r == 'R') && + (l == 'l' || l == 'L') + isUrl _ = False + -- https://drafts.csswg.org/css-syntax-3/#consume-string-token + parseString endingCodePoint d0 = string d0 + where string d t = case t of + c :. ts | c == endingCodePoint -> ret d ts + '\\' :. ts + | Just (p, ts') <- escapedCodePoint ts -> do + d' <- p dst d + string d' ts' + | '\n' :. ts' <- ts -> + string d ts' + | Text _ _ 0 <- ts -> + string d ts + '\n' :. _ -> go' BadString d t + c :. ts -> do + write dst d c + string (d+1) ts + _ -> ret d t + ret d t = go' (String $ Text dsta d0 (d-d0)) d t -isHexChar :: Char -> Bool -isHexChar ch - | ch >= '0' && ch <= '9' = True - | ch >= 'A' && ch <= 'F' = True - | ch >= 'a' && ch <= 'f' = True - | otherwise = False + -- https://drafts.csswg.org/css-syntax/#consume-url-token + parseUrl d0 tUrl = url d0 (skipWhitespace tUrl) + where ret d ts = go' (Url (Text dsta d0 (d-d0))) d ts + url d t = case t of + ')' :. ts -> ret d ts + c :. ts + | c == '"' || c == '\'' || c == '(' + || nonPrintableCodePoint c -> do + badUrl d ts + | isWhitespace c -> + whitespace d ts + '\\' :. ts + | Just (p, ts') <- escapedCodePoint ts -> do + d' <- p dst d + url d' ts' + | otherwise -> + badUrl d ts + c :. ts -> do + write dst d c + url (d+1) ts + _ -> + ret d t + whitespace d t = case t of + c :. ts -> do + if isWhitespace c then + whitespace d ts + else if c == ')' then + ret d ts + else + badUrl d ts + _ -> + ret d t + badUrl d t = case t of + ')' :. ts -> go' BadUrl d ts + (escapedCodePoint' -> Just (_, ts)) -> do + badUrl d ts + _ :. ts -> + badUrl d ts + _ -> go' BadUrl d t + mkText :: A.MArray s -> Int -> Writer s -> ST s (Text, Int, Text) + mkText dest d w = do + (d', ts) <- w dest d + return (Text dsta d (d' - d), d', ts) + r <- go 0 t0 + return (dst, r) -unhex :: (Functor m, Monad m) => String -> m Int -unhex = fmap toInt . go [] - where - go :: Monad m => [Int] -> String -> m [Int] - go acc [] = return acc - go acc (a:r) = do - x <- c a - go (x:acc) r +isWhitespace :: Char -> Bool +isWhitespace '\x0009' = True +isWhitespace '\x000A' = True +isWhitespace '\x0020' = True +isWhitespace _ = False - toInt = sum . map (\(e, x) -> 16 ^ e * x) . zip [(0::Int)..] +nonPrintableCodePoint :: Char -> Bool +nonPrintableCodePoint c + | c >= '\x0000' && c <= '\x0008' = True -- NULL through BACKSPACE + | c == '\x000B' = True -- LINE TABULATION + | c >= '\x000E' && c <= '\x001F' = True -- SHIFT OUT through INFORMATION SEPARATOR ONE + | c == '\x007F' = True -- DELETE + | otherwise = False - c :: Monad m => Char -> m Int - c '0' = return 0 - c '1' = return 1 - c '2' = return 2 - c '3' = return 3 - c '4' = return 4 - c '5' = return 5 - c '6' = return 6 - c '7' = return 7 - c '8' = return 8 - c '9' = return 9 - c 'A' = return 10 - c 'B' = return 11 - c 'C' = return 12 - c 'D' = return 13 - c 'E' = return 14 - c 'F' = return 15 - c 'a' = return 10 - c 'b' = return 11 - c 'c' = return 12 - c 'd' = return 13 - c 'e' = return 14 - c 'f' = return 15 - c _ = fail "Invalid hex digit!" +isExponent :: Char -> Bool +isExponent c = c == 'e' || c == 'E' diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,15 +1,28 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ViewPatterns #-} module Main where +import qualified Data.Text as T import Data.Monoid import Data.CSS.Syntax.Tokens import Test.Hspec +import Test.Hspec.QuickCheck import Prelude +import Test.QuickCheck +import Data.Scientific +testTokenize :: HasCallStack => T.Text -> [Token] -> Expectation +testTokenize s t = do + tokenize s `shouldBe` t + tokenize (serialize (tokenize s)) `shouldBe` t +testSerialize :: HasCallStack => [Token] -> T.Text -> Expectation +testSerialize t s = do + serialize t `shouldBe` s + serialize (tokenize (serialize t)) `shouldBe` s + main :: IO () main = hspec spec @@ -18,213 +31,220 @@ describe "Data.CSS.Syntax.Tokens" $ do it "Single Character" $ do - tokenize "(" `shouldBe` Right [LeftParen] - tokenize ")" `shouldBe` Right [RightParen] - tokenize "[" `shouldBe` Right [LeftSquareBracket] - tokenize "]" `shouldBe` Right [RightSquareBracket] - tokenize ",," `shouldBe` Right [Comma, Comma] + testTokenize "(" [LeftParen] + testTokenize ")" [RightParen] + testTokenize "[" [LeftSquareBracket] + testTokenize "]" [RightSquareBracket] + testTokenize ",," [Comma, Comma] it "Multiple Character" $ do - tokenize "~=" `shouldBe` Right [IncludeMatch] - tokenize "||" `shouldBe` Right [Column] - tokenize "|||" `shouldBe` Right [Column, Delim '|'] - tokenize "" `shouldBe` Right [CDO, CDC] - tokenize "" `shouldBe` Right [CDO, Whitespace, CDC] + testTokenize "~=" [IncludeMatch] + testTokenize "||" [Column] + testTokenize "|||" [Column, Delim '|'] + testTokenize "" [CDO, CDC] + testTokenize "" [CDO, Whitespace, CDC] it "Delimiter" $ do - tokenize "^" `shouldBe` Right [Delim '^'] - tokenize "|" `shouldBe` Right [Delim '|'] - tokenize "\x7f" `shouldBe` Right [Delim '\x7f'] - tokenize "\1" `shouldBe` Right [Delim '\x1'] - tokenize "~-" `shouldBe` Right [Delim '~', Delim '-'] - tokenize "*^" `shouldBe` Right [Delim '*', Delim '^'] + testTokenize "^" [Delim '^'] + testTokenize "|" [Delim '|'] + testTokenize "\x7f" [Delim '\x7f'] + testTokenize "\1" [Delim '\x1'] + testTokenize "~-" [Delim '~', Delim '-'] + testTokenize "*^" [Delim '*', Delim '^'] it "Whitespace" $ do - tokenize " " `shouldBe` Right [Whitespace] - tokenize "\n\rS" `shouldBe` Right [Whitespace, Ident "S"] - tokenize " *" `shouldBe` Right [Whitespace, Delim '*'] - tokenize "\n\r\f2" `shouldBe` Right [Whitespace, Number "2" (NVInteger 2)] + testTokenize " " [Whitespace] + testTokenize "\n\rS" [Whitespace, Ident "S"] + testTokenize " *" [Whitespace, Delim '*'] + testTokenize "\n\r\f2" [Whitespace, Number "2" (NVInteger 2)] it "Escapes" $ do - tokenize "hel\\6Co" `shouldBe` Right [Ident "hello"] - tokenize "\\26 B" `shouldBe` Right [Ident "&B"] - tokenize "'hel\\6c o'" `shouldBe` Right [String '\'' "hello"] - tokenize "'spac\\65\r\ns'" `shouldBe` Right [String '\'' "spaces"] - tokenize "spac\\65\r\ns" `shouldBe` Right [Ident "spaces"] - tokenize "spac\\65\n\rs" `shouldBe` Right [Ident "space", Whitespace, Ident "s"] - tokenize "sp\\61\tc\\65\fs" `shouldBe` Right [Ident "spaces"] - tokenize "hel\\6c o" `shouldBe` Right [Ident "hell", Whitespace, Ident "o"] - tokenize "test\\\n" `shouldBe` Right [Ident "test", Delim '\\', Whitespace] - tokenize "test\\D799" `shouldBe` Right [Ident "test\xD799"] - tokenize "\\E000" `shouldBe` Right [Ident "\xe000"] - tokenize "te\\s\\t" `shouldBe` Right [Ident "test"] - tokenize "spaces\\ in\\\tident" `shouldBe` Right [Ident "spaces in\tident"] - tokenize "\\.\\,\\:\\!" `shouldBe` Right [Ident ".,:!"] - tokenize "\\\r" `shouldBe` Right [Delim '\\', Whitespace] - tokenize "\\\f" `shouldBe` Right [Delim '\\', Whitespace] - tokenize "\\\r\n" `shouldBe` Right [Delim '\\', Whitespace] + testTokenize "hel\\6Co" [Ident "hello"] + testTokenize "\\26 B" [Ident "&B"] + testTokenize "'hel\\6c o'" [String "hello"] + testTokenize "'spac\\65\r\ns'" [String "spaces"] + testTokenize "spac\\65\r\ns" [Ident "spaces"] + testTokenize "spac\\65\n\rs" [Ident "space", Whitespace, Ident "s"] + testTokenize "sp\\61\tc\\65\fs" [Ident "spaces"] + testTokenize "hel\\6c o" [Ident "hell", Whitespace, Ident "o"] + testTokenize "test\\\n" [Ident "test", Delim '\\', Whitespace] + testTokenize "test\\D799" [Ident "test\xD799"] + testTokenize "\\E000" [Ident "\xe000"] + testTokenize "te\\s\\t" [Ident "test"] + testTokenize "spaces\\ in\\\tident" [Ident "spaces in\tident"] + testTokenize "\\.\\,\\:\\!" [Ident ".,:!"] + testTokenize "\\\r" [Delim '\\', Whitespace] + testTokenize "\\\f" [Delim '\\', Whitespace] + testTokenize "\\\r\n" [Delim '\\', Whitespace] -- let replacement = "\xFFFD" - tokenize "null\\\0" `shouldBe` Right [Ident "null\xfffd"] - tokenize "null\\\0\0" `shouldBe` Right [Ident $ "null" <> "\xfffd" <> "\xfffd"] - tokenize "null\\0" `shouldBe` Right [Ident $ "null" <> "\xfffd"] - tokenize "null\\0000" `shouldBe` Right [Ident $ "null" <> "\xfffd"] - tokenize "large\\110000" `shouldBe` Right [Ident $ "large" <> "\xfffd"] - tokenize "large\\23456a" `shouldBe` Right [Ident $ "large" <> "\xfffd"] - tokenize "surrogate\\D800" `shouldBe` Right [Ident $ "surrogate" <> "\xfffd"] - tokenize "surrogate\\0DABC" `shouldBe` Right [Ident $ "surrogate" <> "\xfffd"] - tokenize "\\00DFFFsurrogate" `shouldBe` Right [Ident $ "\xfffd" <> "surrogate"] - tokenize "\\10fFfF" `shouldBe` Right [Ident "\x10ffff"] - tokenize "\\10fFfF0" `shouldBe` Right [Ident $ "\x10ffff" <> "0"] - tokenize "\\10000000" `shouldBe` Right [Ident $ "\x100000" <> "00"] - tokenize "eof\\" `shouldBe` Right [Ident "eof\xfffd"] + testTokenize "null\\\0" [Ident "null\xfffd"] + testTokenize "null\\\0\0" [Ident $ "null" <> "\xfffd" <> "\xfffd"] + testTokenize "null\\0" [Ident $ "null" <> "\xfffd"] + testTokenize "null\\0000" [Ident $ "null" <> "\xfffd"] + testTokenize "large\\110000" [Ident $ "large" <> "\xfffd"] + testTokenize "large\\23456a" [Ident $ "large" <> "\xfffd"] + testTokenize "surrogate\\D800" [Ident $ "surrogate" <> "\xfffd"] + testTokenize "surrogate\\0DABC" [Ident $ "surrogate" <> "\xfffd"] + testTokenize "\\00DFFFsurrogate" [Ident $ "\xfffd" <> "surrogate"] + testTokenize "\\10fFfF" [Ident "\x10ffff"] + testTokenize "\\10fFfF0" [Ident $ "\x10ffff" <> "0"] + testTokenize "\\10000000" [Ident $ "\x100000" <> "00"] + testTokenize "eof\\" [Ident "eof", Delim '\\'] it "Ident" $ do - tokenize "simple-ident" `shouldBe` Right [Ident "simple-ident"] - tokenize "testing123" `shouldBe` Right [Ident "testing123"] - tokenize "hello!" `shouldBe` Right [Ident "hello", Delim '!'] - tokenize "world\5" `shouldBe` Right [Ident "world", Delim '\5'] - tokenize "_under score" `shouldBe` Right [Ident "_under", Whitespace, Ident "score"] - tokenize "-_underscore" `shouldBe` Right [Ident "-_underscore"] - tokenize "-text" `shouldBe` Right [Ident "-text"] - tokenize "-\\6d" `shouldBe` Right [Ident "-m"] - tokenize "--abc" `shouldBe` Right [Ident "--abc"] - tokenize "--" `shouldBe` Right [Ident "--"] - tokenize "--11" `shouldBe` Right [Ident "--11"] - tokenize "---" `shouldBe` Right [Ident "---"] - tokenize "\x2003" `shouldBe` Right [Ident "\x2003"] -- em-space - tokenize "\xA0" `shouldBe` Right [Ident "\xA0"] -- non-breaking space - tokenize "\x1234" `shouldBe` Right [Ident "\x1234"] - tokenize "\x12345" `shouldBe` Right [Ident "\x12345"] - tokenize "\0" `shouldBe` Right [Ident "\xfffd"] - tokenize "ab\0c" `shouldBe` Right [Ident $ "ab\xfffd" <> "c"] + testTokenize "simple-ident" [Ident "simple-ident"] + testTokenize "testing123" [Ident "testing123"] + testTokenize "hello!" [Ident "hello", Delim '!'] + testTokenize "world\5" [Ident "world", Delim '\5'] + testTokenize "_under score" [Ident "_under", Whitespace, Ident "score"] + testTokenize "-_underscore" [Ident "-_underscore"] + testTokenize "-text" [Ident "-text"] + testTokenize "-\\6d" [Ident "-m"] + testTokenize "--abc" [Ident "--abc"] + testTokenize "--" [Ident "--"] + testTokenize "--11" [Ident "--11"] + testTokenize "---" [Ident "---"] + testTokenize "\x2003" [Ident "\x2003"] -- em-space + testTokenize "\xA0" [Ident "\xA0"] -- non-breaking space + testTokenize "\x1234" [Ident "\x1234"] + testTokenize "\x12345" [Ident "\x12345"] + testTokenize "\0" [Ident "\xfffd"] + testTokenize "ab\0c" [Ident $ "ab\xfffd" <> "c"] it "Function" $ do - tokenize "scale(2)" `shouldBe` Right [Function "scale", Number "2" (NVInteger 2), RightParen] - tokenize "foo-bar\\ baz(" `shouldBe` Right [Function "foo-bar baz"] - tokenize "fun\\(ction(" `shouldBe` Right [Function "fun(ction"] - tokenize "-foo(" `shouldBe` Right [Function "-foo"] - tokenize "url(\"foo.gif\"" `shouldBe` Right [Function "url", String '"' "foo.gif"] - tokenize "foo( \'bar.gif\'" `shouldBe` Right [Function "foo", Whitespace, String '\'' "bar.gif"] + testTokenize "scale(2)" [Function "scale", Number "2" (NVInteger 2), RightParen] + testTokenize "foo-bar\\ baz(" [Function "foo-bar baz"] + testTokenize "fun\\(ction(" [Function "fun(ction"] + testTokenize "-foo(" [Function "-foo"] + testTokenize "url(\"foo.gif\"" [Function "url", String "foo.gif"] + testTokenize "foo( \'bar.gif\'" [Function "foo", Whitespace, String "bar.gif"] -- // To simplify implementation we drop the whitespace in function(url),whitespace,string() - tokenize "url( \'bar.gif\'" `shouldBe` Right [Function "url", String '\'' "bar.gif"] + testTokenize "url( \'bar.gif\'" [Function "url", String "bar.gif"] it "AtKeyword" $ do - tokenize "@at-keyword" `shouldBe` Right [AtKeyword "at-keyword"] - tokenize "@hello!" `shouldBe` Right [AtKeyword "hello", Delim '!'] - tokenize "@-text" `shouldBe` Right [AtKeyword "-text"] - tokenize "@--abc" `shouldBe` Right [AtKeyword "--abc"] - tokenize "@--" `shouldBe` Right [AtKeyword "--"] - tokenize "@--11" `shouldBe` Right [AtKeyword "--11"] - tokenize "@---" `shouldBe` Right [AtKeyword "---"] - tokenize "@\\ " `shouldBe` Right [AtKeyword " "] - tokenize "@-\\ " `shouldBe` Right [AtKeyword "- "] - tokenize "@@" `shouldBe` Right [ Delim '@', Delim '@'] - -- tokenize "@2" `shouldBe` Right [ Delim '@', Number "2" (NVInteger 2)] - -- tokenize "@-1" `shouldBe` Right [ Delim '@', Number "-1" (NVInteger (-1))] + testTokenize "@at-keyword" [AtKeyword "at-keyword"] + testTokenize "@hello!" [AtKeyword "hello", Delim '!'] + testTokenize "@-text" [AtKeyword "-text"] + testTokenize "@--abc" [AtKeyword "--abc"] + testTokenize "@--" [AtKeyword "--"] + testTokenize "@--11" [AtKeyword "--11"] + testTokenize "@---" [AtKeyword "---"] + testTokenize "@\\ " [AtKeyword " "] + testTokenize "@-\\ " [AtKeyword "- "] + testTokenize "@@" [Delim '@', Delim '@'] + testTokenize "@2" [Delim '@', Number "2" (NVInteger 2)] + testTokenize "@-1" [Delim '@', Number "-1" (NVInteger (-1))] it "Url" $ do - tokenize "url(foo.gif)" `shouldBe` Right [Url "foo.gif"] - tokenize "urL(https://example.com/cats.png)" `shouldBe` Right [Url "https://example.com/cats.png"] - tokenize "uRl(what-a.crazy^URL~this\\ is!)" `shouldBe` Right [Url "what-a.crazy^URL~this is!"] - tokenize "uRL(123#test)" `shouldBe` Right [Url "123#test"] - tokenize "Url(escapes\\ \\\"\\'\\)\\()" `shouldBe` Right [Url "escapes \"')("] - tokenize "UrL( whitespace )" `shouldBe` Right [Url "whitespace"] - tokenize "URl( whitespace-eof " `shouldBe` Right [Url "whitespace-eof"] - tokenize "URL(eof" `shouldBe` Right [Url "eof"] - tokenize "url(not/*a*/comment)" `shouldBe` Right [Url "not/*a*/comment"] - tokenize "urL()" `shouldBe` Right [Url ""] - tokenize "uRl(white space)," `shouldBe` Right [BadUrl "white space", Comma] - tokenize "Url(b(ad)," `shouldBe` Right [BadUrl "b(ad", Comma] - tokenize "uRl(ba'd):" `shouldBe` Right [BadUrl "ba'd", Colon] - tokenize "urL(b\"ad):" `shouldBe` Right [BadUrl "b\"ad", Colon] - tokenize "uRl(b\"ad):" `shouldBe` Right [BadUrl "b\"ad", Colon] - tokenize "Url(b\\\rad):" `shouldBe` Right [BadUrl "b\\\nad", Colon] - tokenize "url(b\\\nad):" `shouldBe` Right [BadUrl "b\\\nad", Colon] - tokenize "url(/*'bad')*/" `shouldBe` Right [BadUrl "/*'bad'", Delim '*', Delim '/'] - tokenize "url(ba'd\\\\))" `shouldBe` Right [BadUrl "ba'd\\", RightParen] + testTokenize "url(foo.gif)" [Url "foo.gif"] + testTokenize "urL(https://example.com/cats.png)" [Url "https://example.com/cats.png"] + testTokenize "uRl(what-a.crazy^URL~this\\ is!)" [Url "what-a.crazy^URL~this is!"] + testTokenize "uRL(123#test)" [Url "123#test"] + testTokenize "Url(escapes\\ \\\"\\'\\)\\()" [Url "escapes \"')("] + testTokenize "UrL( whitespace )" [Url "whitespace"] + testTokenize "URl( whitespace-eof " [Url "whitespace-eof"] + testTokenize "URL(eof" [Url "eof"] + testTokenize "url(not/*a*/comment)" [Url "not/*a*/comment"] + testTokenize "urL()" [Url ""] + testTokenize "uRl(white space)," [BadUrl, Comma] + testTokenize "Url(b(ad)," [BadUrl, Comma] + testTokenize "uRl(ba'd):" [BadUrl, Colon] + testTokenize "urL(b\"ad):" [BadUrl, Colon] + testTokenize "uRl(b\"ad):" [BadUrl, Colon] + testTokenize "Url(b\\\rad):" [BadUrl, Colon] + testTokenize "url(b\\\nad):" [BadUrl, Colon] + testTokenize "url(/*'bad')*/" [BadUrl, Delim '*', Delim '/'] + testTokenize "url(ba'd\\\\))" [BadUrl, RightParen] it "String" $ do - tokenize "'text'" `shouldBe` Right [String '\'' "text"] - tokenize "\"text\"" `shouldBe` Right [String '"' "text"] - tokenize "'testing, 123!'" `shouldBe` Right [String '\'' "testing, 123!"] - tokenize "'es\\'ca\\\"pe'" `shouldBe` Right [String '\'' "es'ca\"pe"] - tokenize "'\"quotes\"'" `shouldBe` Right [String '\'' "\"quotes\""] - tokenize "\"'quotes'\"" `shouldBe` Right [String '"' "'quotes'"] - tokenize "\"mismatch'" `shouldBe` Right [String '"' "mismatch'"] - tokenize "'text\5\t\xb'" `shouldBe` Right [String '\'' "text\5\t\xb"] - tokenize "\"end on eof" `shouldBe` Right [String '"' "end on eof"] - tokenize "'esca\\\nped'" `shouldBe` Right [String '\'' "escaped"] - tokenize "\"esc\\\faped\"" `shouldBe` Right [String '"' "escaped"] - tokenize "'new\\\rline'" `shouldBe` Right [String '\'' "newline"] - tokenize "\"new\\\r\nline\"" `shouldBe` Right [String '"' "newline"] - tokenize "'bad\nstring" `shouldBe` Right [BadString '\'' "bad", Whitespace, Ident "string"] - tokenize "'bad\rstring" `shouldBe` Right [BadString '\'' "bad", Whitespace, Ident "string"] - tokenize "'bad\r\nstring" `shouldBe` Right [BadString '\'' "bad", Whitespace, Ident "string"] - tokenize "'bad\fstring" `shouldBe` Right [BadString '\'' "bad", Whitespace, Ident "string"] - tokenize "'\0'" `shouldBe` Right [String '\'' "\xFFFD"] - tokenize "'hel\0lo'" `shouldBe` Right [String '\'' "hel\xfffdlo"] - tokenize "'h\\65l\0lo'" `shouldBe` Right [String '\'' "hel\xfffdlo"] + testTokenize "'text'" [String "text"] + testTokenize "\"text\"" [String "text"] + testTokenize "'testing, 123!'" [String "testing, 123!"] + testTokenize "'es\\'ca\\\"pe'" [String "es'ca\"pe"] + testTokenize "'\"quotes\"'" [String "\"quotes\""] + testTokenize "\"'quotes'\"" [String "'quotes'"] + testTokenize "\"mismatch'" [String "mismatch'"] + testTokenize "'text\5\t\xb'" [String "text\5\t\xb"] + testTokenize "\"end on eof" [String "end on eof"] + testTokenize "'esca\\\nped'" [String "escaped"] + testTokenize "\"esc\\\faped\"" [String "escaped"] + testTokenize "'new\\\rline'" [String "newline"] + testTokenize "\"new\\\r\nline\"" [String "newline"] + testTokenize "'bad\nstring" [BadString, Whitespace, Ident "string"] + testTokenize "'bad\rstring" [BadString, Whitespace, Ident "string"] + testTokenize "'bad\r\nstring" [BadString, Whitespace, Ident "string"] + testTokenize "'bad\fstring" [BadString, Whitespace, Ident "string"] + testTokenize "'\0'" [String "\xFFFD"] + testTokenize "'hel\0lo'" [String "hel\xfffdlo"] + testTokenize "'h\\65l\0lo'" [String "hel\xfffdlo"] + testTokenize "'ignore backslash at eof\\" [String "ignore backslash at eof"] it "Hash" $ do - tokenize "#id-selector" `shouldBe` Right [Hash HId "id-selector"] - tokenize "#FF7700" `shouldBe` Right [Hash HId "FF7700"] - -- tokenize "#3377FF" `shouldBe` Right [Hash HUnrestricted "3377FF"] - tokenize "#\\ " `shouldBe` Right [Hash HId " "] - tokenize "# " `shouldBe` Right [Delim '#', Whitespace] - tokenize "#\\\n" `shouldBe` Right [Delim '#', Delim '\\', Whitespace] - tokenize "#\\\r\n" `shouldBe` Right [Delim '#', Delim '\\', Whitespace] - tokenize "#!" `shouldBe` Right [Delim '#', Delim '!'] + testTokenize "#id-selector" [Hash HId "id-selector"] + testTokenize "#FF7700" [Hash HId "FF7700"] + testTokenize "#3377FF" [Hash HUnrestricted "3377FF"] + testTokenize "#\\ " [Hash HId " "] + testTokenize "# " [Delim '#', Whitespace] + testTokenize "#\\\n" [Delim '#', Delim '\\', Whitespace] + testTokenize "#\\\r\n" [Delim '#', Delim '\\', Whitespace] + testTokenize "#!" [Delim '#', Delim '!'] it "Number" $ do - tokenize "10" `shouldBe` Right [Number "10" (NVInteger 10)] - tokenize "12.0" `shouldBe` Right [Number "12.0" (NVNumber 12)] - tokenize "+45.6" `shouldBe` Right [Number "+45.6" (NVNumber 45.6)] - tokenize "-7" `shouldBe` Right [Number "-7" (NVInteger (-7))] - tokenize "010" `shouldBe` Right [Number "010" (NVInteger 10)] - tokenize "10e0" `shouldBe` Right [Number "10e0" (NVNumber 10)] - tokenize "12e3" `shouldBe` Right [Number "12e3" (NVNumber 12000)] - tokenize "3e+1" `shouldBe` Right [Number "3e+1" (NVNumber 30)] - tokenize "12E-1" `shouldBe` Right [Number "12E-1" (NVNumber 1.2)] - tokenize ".7" `shouldBe` Right [Number ".7" (NVNumber 0.7)] - tokenize "-.3" `shouldBe` Right [Number "-.3" (NVNumber (-0.3))] - tokenize "+637.54e-2" `shouldBe` Right [Number "+637.54e-2" (NVNumber 6.3754)] - tokenize "-12.34E+2" `shouldBe` Right [Number "-12.34E+2" (NVNumber (-1234))] - tokenize "+ 5" `shouldBe` Right [Delim '+', Whitespace, Number "5" (NVInteger 5)] - tokenize "-+12" `shouldBe` Right [Delim '-', Number "+12" (NVInteger 12)] - tokenize "+-21" `shouldBe` Right [Delim '+', Number "-21" (NVInteger (-21))] - tokenize "++22" `shouldBe` Right [Delim '+', Number "+22" (NVInteger 22)] - tokenize "13." `shouldBe` Right [Number "13" (NVInteger 13), Delim ('.')] - tokenize "1.e2" `shouldBe` Right [Number "1" (NVInteger 1), Delim '.', Ident "e2"] - tokenize "2e3.5" `shouldBe` Right [Number "2e3" (NVNumber 2e3), Number ".5" (NVNumber 0.5)] - tokenize "2e3." `shouldBe` Right [Number "2e3" (NVNumber 2e3), Delim '.'] - tokenize "1000000000000000000000000" `shouldBe` Right [Number "1000000000000000000000000" (NVInteger 1e24)] + testTokenize "10" [Number "10" (NVInteger 10)] + testTokenize "12.0" [Number "12.0" (NVNumber 12)] + testTokenize "+45.6" [Number "+45.6" (NVNumber 45.6)] + testTokenize "-7" [Number "-7" (NVInteger (-7))] + testTokenize "010" [Number "010" (NVInteger 10)] + testTokenize "10e0" [Number "10e0" (NVNumber 10)] + testTokenize "12e3" [Number "12e3" (NVNumber 12000)] + testTokenize "3e+1" [Number "3e+1" (NVNumber 30)] + testTokenize "12E-1" [Number "12E-1" (NVNumber 1.2)] + testTokenize ".7" [Number ".7" (NVNumber 0.7)] + testTokenize "-.3" [Number "-.3" (NVNumber (-0.3))] + testTokenize "+637.54e-2" [Number "+637.54e-2" (NVNumber 6.3754)] + testTokenize "-12.34E+2" [Number "-12.34E+2" (NVNumber (-1234))] + testTokenize "+ 5" [Delim '+', Whitespace, Number "5" (NVInteger 5)] + testTokenize "-+12" [Delim '-', Number "+12" (NVInteger 12)] + testTokenize "+-21" [Delim '+', Number "-21" (NVInteger (-21))] + testTokenize "++22" [Delim '+', Number "+22" (NVInteger 22)] + testTokenize "13." [Number "13" (NVInteger 13), Delim ('.')] + testTokenize "1.e2" [Number "1" (NVInteger 1), Delim '.', Ident "e2"] + testTokenize "2e3.5" [Number "2e3" (NVNumber 2e3), Number ".5" (NVNumber 0.5)] + testTokenize "2e3." [Number "2e3" (NVNumber 2e3), Delim '.'] + testTokenize "1000000000000000000000000" [Number "1000000000000000000000000" (NVInteger 1000000000000000000000000)] + testTokenize "123456789223456789323456789423456789523456789623456789723456789823456789923456789" [Number "123456789223456789323456789423456789523456789623456789723456789823456789923456789" (NVInteger 123456789223456789323456789423456789523456789623456789723456789823456789923456789)] + testTokenize "1.797693134862315708145274237317043567980705675258449965989174768031572607800285387605895586327668781715404589535143824642e308" [Number "1.797693134862315708145274237317043567980705675258449965989174768031572607800285387605895586327668781715404589535143824642e308" (NVNumber 1.797693134862315708145274237317043567980705675258449965989174768031572607800285387605895586327668781715404589535143824642e308)] it "Dimension" $ do - tokenize "10px" `shouldBe` Right [Dimension "10" (NVInteger 10) "px"] - tokenize "12.0em" `shouldBe` Right [Dimension "12.0" (NVNumber 12) "em"] - tokenize "-12.0em" `shouldBe` Right [Dimension "-12.0" (NVNumber (-12)) "em"] - tokenize "+45.6__qem" `shouldBe` Right [Dimension "+45.6" (NVNumber 45.6) "__qem"] - tokenize "5e" `shouldBe` Right [Dimension "5" (NVInteger 5) "e"] - tokenize "5px-2px" `shouldBe` Right [Dimension "5" (NVInteger 5) "px-2px"] - tokenize "5e-" `shouldBe` Right [Dimension "5" (NVInteger 5) "e-"] - tokenize "5\\ " `shouldBe` Right [Dimension "5" (NVInteger 5) " "] - tokenize "40\\70\\78" `shouldBe` Right [Dimension "40" (NVInteger 40) "px"] - tokenize "4e3e2" `shouldBe` Right [Dimension "4e3" (NVNumber 4e3) "e2"] - tokenize "0x10px" `shouldBe` Right [Dimension "0" (NVInteger 0) "x10px"] - tokenize "4unit " `shouldBe` Right [Dimension "4" (NVInteger 4) "unit", Whitespace] - tokenize "5e+" `shouldBe` Right [Dimension "5" (NVInteger 5) "e", Delim '+'] - tokenize "2e.5" `shouldBe` Right [Dimension "2" (NVInteger 2) "e", Number ".5" (NVNumber 0.5)] - tokenize "2e+.5" `shouldBe` Right [Dimension "2" (NVInteger 2) "e", Number "+.5" (NVNumber 0.5)] + testTokenize "10px" [Dimension "10" (NVInteger 10) "px"] + testTokenize "12.0em" [Dimension "12.0" (NVNumber 12) "em"] + testTokenize "-12.0em" [Dimension "-12.0" (NVNumber (-12)) "em"] + testTokenize "+45.6__qem" [Dimension "+45.6" (NVNumber 45.6) "__qem"] + testTokenize "5e" [Dimension "5" (NVInteger 5) "e"] + testTokenize "5px-2px" [Dimension "5" (NVInteger 5) "px-2px"] + testTokenize "5e-" [Dimension "5" (NVInteger 5) "e-"] + testTokenize "5\\ " [Dimension "5" (NVInteger 5) " "] + testTokenize "40\\70\\78" [Dimension "40" (NVInteger 40) "px"] + testTokenize "4e3e2" [Dimension "4e3" (NVNumber 4e3) "e2"] + testTokenize "0x10px" [Dimension "0" (NVInteger 0) "x10px"] + testTokenize "4unit " [Dimension "4" (NVInteger 4) "unit", Whitespace] + testTokenize "5e+" [Dimension "5" (NVInteger 5) "e", Delim '+'] + testTokenize "2e.5" [Dimension "2" (NVInteger 2) "e", Number ".5" (NVNumber 0.5)] + testTokenize "2e+.5" [Dimension "2" (NVInteger 2) "e", Number "+.5" (NVNumber 0.5)] + testTokenize "1-2" [Number "1" (NVInteger 1), Number "-2" (NVInteger (-2))] + testTokenize "1\\65 1" [Dimension "1" (NVInteger 1) "e1"] + testTokenize "1\\31 em" [Dimension "1" (NVInteger 1) "1em"] + testTokenize "1e\\31 em" [Dimension "1" (NVInteger 1) "e1em"] it "Percentage" $ do - tokenize "10%" `shouldBe` Right [Percentage "10" $ NVInteger 10] - tokenize "+12.0%" `shouldBe` Right [Percentage "+12.0" $ NVNumber 12.0] - tokenize "-48.99%" `shouldBe` Right [Percentage "-48.99" $ NVNumber (-48.99)] - tokenize "6e-1%" `shouldBe` Right [Percentage "6e-1" $ NVNumber 6e-1] - tokenize "5%%" `shouldBe` Right [Percentage "5" (NVInteger 5), Delim '%'] + testTokenize "10%" [Percentage "10" $ NVInteger 10] + testTokenize "+12.0%" [Percentage "+12.0" $ NVNumber 12.0] + testTokenize "-48.99%" [Percentage "-48.99" $ NVNumber (-48.99)] + testTokenize "6e-1%" [Percentage "6e-1" $ NVNumber 6e-1] + testTokenize "5%%" [Percentage "5" (NVInteger 5), Delim '%'] -- 402 TEST(CSSTokenizerTest, UnicodeRangeToken) @@ -251,10 +271,125 @@ -- 423 TEST_TOKENS("u+-543", ident("u"), delim('+'), number(IntegerValueType, -543, MinusSign)); it "Comment" $ do - tokenize "/*comment*/a" `shouldBe` Right [Ident "a"] - tokenize "/**\\2f**//" `shouldBe` Right [Delim '/'] - tokenize "/**y*a*y**/ " `shouldBe` Right [Whitespace] - tokenize ",/* \n :) \n */)" `shouldBe` Right [Comma, RightParen] - tokenize ":/*/*/" `shouldBe` Right [Colon] - tokenize "/**/*" `shouldBe` Right [Delim '*'] - tokenize ";/******" `shouldBe` Right [Semicolon] + testTokenize "/*comment*/a" [Ident "a"] + testTokenize "/**\\2f**//" [Delim '/'] + testTokenize "/**y*a*y**/ " [Whitespace] + testTokenize ",/* \n :) \n */)" [Comma, RightParen] + testTokenize ":/*/*/" [Colon] + testTokenize "/**/*" [Delim '*'] + testTokenize ";/******" [Semicolon] + + it "Serialization" $ do + testSerialize [String "hello,\x0world"] "\"hello,\xFFFDworld\"" + testSerialize [String "\x10\x7f\""] "\"\\10 \\7f \\\"\"" + testSerialize [String "\xABCDE"] "\"\xABCDE\"" + testSerialize [Ident "-"] "\\-" + testSerialize [Ident "5"] "\\35 " + testSerialize [Ident "-5"] "-\\35 " + testSerialize [Ident "-9f\\oo()"] "-\\39 f\\\\oo\\(\\)" + testSerialize [Ident "\xABCDE"] "\xABCDE" + testSerialize [Ident "a", Ident "b"] "a/**/b" + testSerialize [Dimension "1" (NVInteger 1) "em", Ident "b"] "1em/**/b" + + it "Doesn't regress Tokenize=>serialize=>tokenize roundtrip" $ do + let a = tokenize "\\-->" + tokenize (serialize a) `shouldBe` a + + modifyMaxSize (const 500) $ modifyMaxSuccess (const 100000) $ + prop "Tokenize=>serialize=>tokenize roundtrip" + prop_tstRoundTrip + modifyMaxSize (const 50) $ modifyMaxSuccess (const 100000) $ + prop "Serialize=>tokenize roundtrip" + prop_stRoundTrip + +prop_tstRoundTrip :: String -> Bool +prop_tstRoundTrip s = tokenize (serialize t) == t + where t = tokenize $ T.pack s + +prop_stRoundTrip :: TestTokens -> Bool +prop_stRoundTrip (TestTokens t) = tokenize (serialize t) == t + +newtype TestTokens = TestTokens [Token] + deriving (Show, Eq) + +instance Arbitrary TestTokens where + arbitrary = TestTokens . go <$> arbitrary + where go [] = [] + go (x : xs@(Whitespace : _)) | needWhitespace x = x : go xs + -- we can only have [BadString, Whitespace] + -- or [Delim '\\', Whitespace] sequences + go (x : xs) | needWhitespace x = x : Whitespace : go xs + go (x@(Function (T.toLower -> "url")) : xs) = + x : String "argument" : go xs + go (x : xs) = x : go xs + needWhitespace x = case x of + BadString -> True + Delim '\\' -> True + _ -> False + + +instance Arbitrary Token where + arbitrary = oneof $ + map return + [ Whitespace + , CDO + , CDC + + , Comma + , Colon + , Semicolon + + , LeftParen + , RightParen + , LeftSquareBracket + , RightSquareBracket + , LeftCurlyBracket + , RightCurlyBracket + + , SuffixMatch + , SubstringMatch + , PrefixMatch + , DashMatch + , IncludeMatch + + , Column + + , BadString + , BadUrl + ] + ++ + [ String <$> text + , num Number + , num Percentage + , num Dimension <*> ident + + , Url <$> text + + , Ident <$> ident + + , AtKeyword <$> ident + + , Function <$> ident + , return $ Function "url" + + , Hash HId <$> ident + + , Delim <$> elements possibleDelimiters + ] + where ident = notEmpty text + notEmpty x = do + r <- x + if r /= "" then return r else notEmpty x + text = T.replace "\NUL" "\xFFFD" . T.pack <$> arbitrary + num token = do + c <- arbitrary + e <- arbitrary + let (t, n) + | e /= 0 = nv NVNumber (scientific c e) + | otherwise = nv NVInteger c + nv f x = (T.pack $ show x, f x) + return $ token t n + possibleDelimiters = + [d | c <- ['\0'..'\xff'] + , [Delim d] <- [tokenize (T.pack [c])]] + ++ ['\\']