css-syntax 0.0.8 → 0.1.0.0
raw patch · 4 files changed
+1025/−519 lines, 4 filesdep +QuickCheckdep +criteriondep +deepseqdep −attoparsecdep −bytestringdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, criterion, deepseq
Dependencies removed: attoparsec, bytestring
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.CSS.Syntax.Tokens: BadString :: !Char -> !Text -> Token
+ Data.CSS.Syntax.Tokens: BadString :: Token
- Data.CSS.Syntax.Tokens: BadUrl :: !Text -> Token
+ Data.CSS.Syntax.Tokens: BadUrl :: Token
- Data.CSS.Syntax.Tokens: NVInteger :: !Scientific -> NumericValue
+ Data.CSS.Syntax.Tokens: NVInteger :: !Integer -> NumericValue
- Data.CSS.Syntax.Tokens: String :: !Char -> !Text -> Token
+ Data.CSS.Syntax.Tokens: String :: !Text -> Token
- Data.CSS.Syntax.Tokens: tokenize :: Text -> Either String [Token]
+ Data.CSS.Syntax.Tokens: tokenize :: Text -> [Token]
Files
- benchmark/Benchmark.hs +87/−0
- css-syntax.cabal +28/−10
- src/Data/CSS/Syntax/Tokens.hs +593/−323
- test/Test.hs +317/−186
+ benchmark/Benchmark.hs view
@@ -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" <> " "
css-syntax.cabal view
@@ -1,7 +1,7 @@ name: css-syntax-version: 0.0.8+version: 0.1.0.0 -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 <tomas.carnecky@gmail.com>, Vladimir Shabanov <dev@vshabanov.com>+maintainer: Tomas Carnecky <tomas.carnecky@gmail.com> category: Data @@ -32,18 +32,16 @@ build-depends: base >=4 && <5- , attoparsec >=0.13- , bytestring , scientific , text - 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
src/Data/CSS/Syntax/Tokens.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, RankNTypes, PatternSynonyms, ViewPatterns,+ BangPatterns #-} 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.Base (unsafeChr)+import Data.Word (Word16)+import Data.Char (ord)+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,359 +114,655 @@ -- 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 $ \ 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' ->+ put '\xFFFD' t'+ 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 Word16 from Text without trying to decode UTF-16 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 16bit character+write :: A.MArray s -> Int -> Char -> ST s ()+write dst d x = A.unsafeWrite dst d (c2w x)+{-# INLINE write #-} --- Serialization--------------------------------------------------------------------------------+-- | write character that could have more than 16bit+-- code from Data.Text.Internal.Unsafe.Char.unsafeWrite+writeChar :: A.MArray s -> Int -> Char -> ST s Int+writeChar dst d c+ | n < 0x10000 = do+ A.unsafeWrite dst d (fromIntegral n)+ return (d+1)+ | otherwise = do+ A.unsafeWrite dst d lo+ A.unsafeWrite dst (d+1) hi+ return (d+2)+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE writeChar #-} +type Writer' s = (A.MArray s -> Int -> ST s Int, Text)+type Writer s = A.MArray s -> Int -> ST s (Int, Text) --- | 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+-- | no-op for convenient pattern matching+w2c :: Word16 -> Char+w2c = unsafeChr . fromIntegral+{-# INLINE w2c #-} -serialize :: [Token] -> Text-serialize = mconcat . map renderToken+c2w :: Char -> Word16+c2w = fromIntegral . ord+{-# INLINE c2w #-} +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 :: Token -> Text-renderToken (Whitespace) = " " -renderToken (CDO) = "<!--"-renderToken (CDC) = "-->"+-- Serialization+------------------------------------------------------------------------------- -renderToken (Comma) = ","-renderToken (Colon) = ":"-renderToken (Semicolon) = ";" -renderToken (LeftParen) = "("-renderToken (RightParen) = ")"-renderToken (LeftSquareBracket) = "["-renderToken (RightSquareBracket) = "]"-renderToken (LeftCurlyBracket) = "{"-renderToken (RightCurlyBracket) = "}"+-- | 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 (SuffixMatch) = "$="-renderToken (SubstringMatch) = "*="-renderToken (PrefixMatch) = "^="-renderToken (DashMatch) = "|="-renderToken (IncludeMatch) = "~=" -renderToken (Column) = "||"+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 (String d x) = T.singleton d <> renderString x <> T.singleton d-renderToken (BadString d x) = T.singleton d <> renderString x <> T.singleton d+{-# INLINE renderToken #-}+{-# INLINE needComment #-} -renderToken (Number x _) = x-renderToken (Percentage x _) = x <> "%"-renderToken (Dimension x _ u) = x <> u+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 _ -> 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 -renderToken (Url x) = "url(" <> x <> ")"-renderToken (BadUrl x) = "url(" <> x <> ")" -renderToken (Ident x) = x+renderToken :: Token -> TLB.Builder+renderToken token = case token of+ Whitespace -> c ' ' -renderToken (AtKeyword x) = "@" <> x+ CDO -> "<!--"+ CDC -> "-->" -renderToken (Function x) = x <> "("+ Comma -> c ','+ Colon -> c ':'+ Semicolon -> c ';' -renderToken (Hash _ x) = "#" <> x+ LeftParen -> c '('+ RightParen -> c ')'+ LeftSquareBracket -> c '['+ RightSquareBracket -> c ']'+ LeftCurlyBracket -> c '{'+ RightCurlyBracket -> c '}' -renderToken (Delim x) = T.singleton x+ SuffixMatch -> "$="+ SubstringMatch -> "*="+ PrefixMatch -> "^="+ DashMatch -> "|="+ IncludeMatch -> "~=" + Column -> "||" + String x -> string x+ BadString -> "\"\n" -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+ Number x _ -> t x+ Percentage x _ -> t x <> c '%'+ Dimension x _ u -> t x <> t (renderDimensionUnit x u) - nonASCIICodePoint c = c >= '\x0080' -- control+ Url x -> "url(" <> t (renderUrl x) <> c ')'+ BadUrl -> "url(()" - f c = if nonPrintableCodePoint c || nonASCIICodePoint c- then "\\" <> showHex (ord c) ""- else [c]+ Ident x -> ident x + AtKeyword x -> c '@' <> ident x -parseComment :: Parser ()-parseComment = do- void $ AP.string "/*"- void $ AP.manyTill' AP.anyChar (void (AP.string "*/") <|> AP.endOfInput)+ Function x -> ident x <> c '(' -parseWhitespace :: Parser Token-parseWhitespace = do- void $ AP.takeWhile1 isWhitespace- return Whitespace+ Hash HId x -> c '#' <> ident x+ Hash HUnrestricted x -> c '#' <> t (renderUnrestrictedHash x) -parseChar :: Token -> Char -> Parser Token-parseChar t c = do- _ <- AP.char c- return t+ 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 -parseStr :: Token -> Text -> Parser Token-parseStr t str = AP.string str *> return t+-- https://www.w3.org/TR/cssom-1/#serialize-a-string -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+renderString :: Text -> Text+renderString t0@(Text _ _ l)+ | T.any needEscape t0 = withNewA (l*8) $ go t0 0+ | otherwise = t0+ where+ 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+ write dst d '\xFFFD'+ -- spec says it should be escaped, but we loose+ -- serialize->tokenize->serialize roundtrip that way+ go t' (d+1) 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 +renderUrl :: Text -> Text+renderUrl t0@(Text _ _ l)+ | T.any needEscape t0 = withNewA (l*8) $ go t0 0+ | otherwise = t0 where- f :: String -> Char -> Maybe String- f acc c =- if length acc < 6 && isHexChar c- then Just $ c:acc- else Nothing+ 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+ write dst d '\xFFFD'+ go t' (d+1) dst+ | needEscape c -> do+ d' <- escapeAsCodePoint dst d c+ go t' d' dst+ | otherwise -> do+ d' <- writeChar dst d c+ go t' d' dst +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 -nextInputCodePoint :: Parser Char-nextInputCodePoint = escapedCodePoint' <|> AP.anyChar+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 +renderUnrestrictedHash :: Text -> Text+renderUnrestrictedHash t0@(Text _ _ l)+ | T.any (not . nameCodePoint) t0 =+ withNewA (l*8) $ renderUnrestrictedHash' t0 0+ | otherwise = t0 -whenNext :: Char -> a -> Parser a-whenNext c a = do- mbChar <- AP.peekChar- if mbChar == Just c- then return a- else fail "whenNext"+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+ write dst d '\xFFFD'+ go t' (d+1) 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 --- 4.3.4. Consume a string token-parseString :: Char -> Parser Token-parseString endingCodePoint = do- _ <- AP.char endingCodePoint- go []+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) - 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)- ] -fromAcc :: [Char] -> Text-fromAcc = T.pack . reverse+-- | 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 (safe -> c) ts+ | c < 0x10000 = Just+ (\ dst d -> write dst d (unsafeChr c) >> return (d+1), ts)+ | otherwise = Just+ (\ dst d -> write dst d lo >> write dst (d+1) hi >> return (d+2)+ ,ts)+ where m = c - 0x10000+ lo = unsafeChr $ (m `shiftR` 10) + 0xD800+ hi = unsafeChr $ (m .&. 0x3FF) + 0xDC00 -parseHash :: Parser Token-parseHash = do- _ <- AP.char '#'- name <- parseName- return $ Hash HId name+safe :: Int -> Int+safe x+ | x == 0 || x > 0x10FFFF = 0xFFFD+ | x .&. 0x1ff800 /= 0xd800 = x+ | otherwise = 0xFFFD -- UTF16 surrogate code point -isNameStartCodePoint :: Char -> Bool-isNameStartCodePoint c = isLetter c || c >= '\x0080' || c == '_'+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 -isNameCodePoint :: Char -> Bool-isNameCodePoint c = isNameStartCodePoint c || isDigit c || c == '-'+{-# INLINE safe #-}+{-# INLINE hex #-} -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+escapedCodePoint' :: Text -> Maybe (Writer' s)+escapedCodePoint' ('\\' :. ts) = escapedCodePoint ts+escapedCodePoint' _ = Nothing -nameCodePoint :: Parser Char-nameCodePoint = AP.satisfy isNameCodePoint+nameStartCodePoint :: Char -> Bool+nameStartCodePoint c =+ isAsciiLower c || isAsciiUpper c || c >= '\x0080' || c == '_' -escapedCodePoint' :: Parser Char-escapedCodePoint' = do- _ <- AP.char '\\'- escapedCodePoint+nameCodePoint :: Char -> Bool+nameCodePoint c = nameStartCodePoint c || isDigit c || c == '-' -parseName :: Parser Text-parseName = do- chars <- AP.many1' $- nameCodePoint <|> escapedCodePoint'+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 - case chars of- '-':xs -> case xs of- _:_ -> return $ T.pack chars- _ -> fail "parseName: Not a valid name start"- _ -> return $ T.pack chars+-- | 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) -parseSign :: Parser (Text, Int)-parseSign = do- mbChar <- AP.peekChar- case mbChar of- Just '+' -> AP.anyChar >> return ("+", 1)- Just '-' -> AP.anyChar >> return ("-", (-1))- _ -> return ("", 1)--parseNumericValue :: Parser (Text, NumericValue)-parseNumericValue = do- -- Sign- (sS, s) <- parseSign-- -- 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)+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) - -- 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)+{-# INLINE parseName #-}+{-# INLINE consumeName #-}+{-# INLINE satisfyOrEscaped #-}+{-# INLINE escapedCodePoint #-}+{-# INLINE escapedCodePoint' #-} - -- 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+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 - return (T.singleton e <> tS, t, eS, read $ T.unpack eS, True)+-- 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. - 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)+blockDigits :: Int+blockDigits = 40 +startBase :: Integer+startBase = 10^blockDigits -parseUrl :: Parser Token-parseUrl = do- _ <- AP.takeWhile isWhitespace- go []+-- | (num digits in current block, blocks, current block's value)+type IntegerReader = (Int, [Integer], Integer) - where- endOfUrl acc = (AP.endOfInput <|> void (AP.char ')')) *> return (Url $ fromAcc acc)+startIR :: Integer -> IntegerReader+startIR d = (1, [], d) - 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)- ]+{-# INLINE startIR #-}+{-# INLINE accIR #-}+{-# INLINE readIR #-} - badUrl acc = choice- [ (AP.endOfInput <|> void (AP.char ')')) *> return (BadUrl $ fromAcc acc)- , nextInputCodePoint >>= \ch -> badUrl (ch:acc)- ]+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 -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)+skipComment :: Text -> Text+skipComment t = case t of+ '*' :. '/' :. ts -> ts+ _ :. ts -> skipComment ts+ ts -> ts - void $ AP.char '('- void $ AP.takeWhile isWhitespace+skipWhitespace :: Text -> Text+skipWhitespace t = case t of+ c :. ts+ | isWhitespace c -> skipWhitespace ts+ | otherwise -> t+ ts -> ts - whenNext '"' (Function name) <|> whenNext '\'' (Function name) <|> parseUrl+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) - , AP.char '(' *> return (Function name)- , return (Ident name)- ]+ '<' :. '!' :. '-' :. '-' :. ts -> token CDO ts+ '-' :. '-' :. '>' :. ts -> token CDC ts + ',' :. 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 -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"+ '$' :. '=' :. ts -> token SuffixMatch ts+ '*' :. '=' :. ts -> token SubstringMatch ts+ '^' :. '=' :. ts -> token PrefixMatch ts+ '|' :. '=' :. ts -> token DashMatch ts+ '~' :. '=' :. ts -> token IncludeMatch ts -parseAtKeyword :: Parser Token-parseAtKeyword = do- _ <- AP.char '@'- name <- parseName- return $ AtKeyword name+ '|' :. '|' :. ts -> token Column ts + (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 -parseToken :: Parser Token-parseToken = AP.many' parseComment *> choice- [ parseWhitespace+ -- 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 - , AP.string "<!--" *> return CDO- , AP.string "-->" *> return CDC+ '"' :. ts -> parseString '"' d ts+ '\'' :. ts -> parseString '\'' d ts - , parseChar Comma ','- , parseChar Colon ':'- , parseChar Semicolon ';'- , parseChar LeftParen '('- , parseChar RightParen ')'- , parseChar LeftSquareBracket '['- , parseChar RightSquareBracket ']'- , parseChar LeftCurlyBracket '{'- , parseChar RightCurlyBracket '}'+ '@' :. (parseName -> Just n) -> do+ (name, d', ts) <- mkText dst d n+ go' (AtKeyword name) d' ts - , parseStr SuffixMatch "$="- , parseStr SubstringMatch "*="- , parseStr PrefixMatch "^="- , parseStr DashMatch "|="- , parseStr IncludeMatch "~="+ '#' :. (parseName -> Just n) -> do+ (name, d', ts) <- mkText dst d n+ go' (Hash HId name) d' ts - , parseStr Column "||"+ '#' :. (satisfyOrEscaped nameCodePoint -> Just n) -> do+ (name, d', ts) <- mkText dst d (consumeName n)+ go' (Hash HUnrestricted name) d' ts - , parseNumeric+ c :. ts ->+ token (Delim c) ts+ _ -> return [] - , parseEscapedIdentLike- , parseIdentLike- , parseHash+ where token t ts = go' t d ts - , parseString '"'- , parseString '\''+ isUrl t@(Text _ _ 3)+ | u :. r :. l :. _ <- t =+ (u == 'u' || u == 'U') &&+ (r == 'r' || r == 'R') &&+ (l == 'l' || l == 'L')+ isUrl _ = False - , parseAtKeyword+ -- 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 - , AP.anyChar >>= return . Delim- ] <?> "token"+ -- 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) isWhitespace :: Char -> Bool@@ -466,48 +771,13 @@ isWhitespace '\x0020' = True isWhitespace _ = False --isHexChar :: Char -> Bool-isHexChar ch- | ch >= '0' && ch <= '9' = True- | ch >= 'A' && ch <= 'F' = True- | ch >= 'a' && ch <= 'f' = True- | otherwise = False---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-- 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'
test/Test.hs view
@@ -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]- tokenize "<!---" `shouldBe` Right [CDO, Delim '-']- tokenize "<!---->" `shouldBe` Right [CDO, CDC]- tokenize "<!-- -->" `shouldBe` Right [CDO, Whitespace, CDC]+ testTokenize "~=" [IncludeMatch]+ testTokenize "||" [Column]+ testTokenize "|||" [Column, Delim '|']+ testTokenize "<!--" [CDO]+ testTokenize "<!---" [CDO, 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,121 @@ -- 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"++ modifyMaxSize (const 500) $ modifyMaxSuccess (const 100000) $+ prop "Tokeninze=>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])]]+ ++ ['\\']