From 2ba0a92aba6caba9a3bfaf7b678aed73f984d9e3 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 4 May 2020 19:45:53 +1200 Subject: [PATCH] Start testing counters implementations, fix syntactic shorthand lowering for counter[s]() functions. --- src/Data/CSS/Preprocessor/Text.hs | 4 +- src/Data/CSS/Style/Cascade.hs | 2 +- test/Test.hs | 48 ++++++++++++++++++++++++ xml-conduit-stylist/src/Data/HTML2CSS.hs | 5 +-- 4 files changed, 54 insertions(+), 5 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Text.hs b/src/Data/CSS/Preprocessor/Text.hs index 6796204..3f55845 100644 --- a/src/Data/CSS/Preprocessor/Text.hs +++ b/src/Data/CSS/Preprocessor/Text.hs @@ -54,7 +54,9 @@ instance PropertyParser p => PropertyParser (TextStyle p) where shorthand self "white-space" [Ident val] | val `elem` ["normal", "pre", "pre-wrap", "pre-line"] = [("white-space", [Ident val])] | otherwise = shorthand (inner self) "white-space" [Ident val] - shorthand self key value = shorthand (inner self) key $ removeCounters value + shorthand TextStyle { inner = self' } key value + | [(k, _)] <- shorthand self' key $ removeCounters value, k == key = [(key, value)] + | otherwise = shorthand self' key value longhand _ self "counter-reset" value = (\v -> self {counterReset = v}) <$> parseCounters 0 value longhand _ self "counter-increment" value = (\v -> self {counterIncrement = v}) <$> parseCounters 1 value diff --git a/src/Data/CSS/Style/Cascade.hs b/src/Data/CSS/Style/Cascade.hs index 501b44c..5b3af5c 100644 --- a/src/Data/CSS/Style/Cascade.hs +++ b/src/Data/CSS/Style/Cascade.hs @@ -38,7 +38,7 @@ class PropertyParser a where setVars _ = id -- | Gather properties into a hashmap. -data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token]) +data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token]) deriving (Show, Eq) instance PropertyParser TrivialPropertyParser where temp = TrivialPropertyParser empty longhand _ (TrivialPropertyParser self) key value = diff --git a/test/Test.hs b/test/Test.hs index 6fa5922..428da82 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -15,9 +15,11 @@ import Data.CSS.Style.Common import Data.CSS.Style.Selector.Index import Data.CSS.Style.Selector.Interpret import Data.CSS.Style +import Data.CSS.StyleTree import Data.CSS.Preprocessor.Conditions import Data.CSS.Preprocessor.Conditions.Expr (Datum(..), Op(..), parse', eval) +import qualified Data.CSS.Preprocessor.Text as Txt main :: IO () main = hspec spec @@ -445,6 +447,52 @@ spec = do extractImports' styles `shouldBe` [] -- TODO @supports is harder to test + describe "CSS Counters" $ do + it "Propagates other properties" $ do + let textStyle = temp :: Txt.TextStyle TrivialPropertyParser + let textStyle1 = fromJust $ longhand temp textStyle "foo" [Ident "bar"] + style (Txt.resolve $ StyleTree textStyle1 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"])]) + + let textStyle2 = fromJust $ longhand temp textStyle1 "counter-reset" [Ident "heading"] + style (Txt.resolve $ StyleTree textStyle2 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"])]) + + let textStyle3 = fromJust $ longhand temp textStyle2 "counter-set" [Ident "heading"] + style (Txt.resolve $ StyleTree textStyle3 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"])]) + + let textStyle4 = fromJust $ longhand temp textStyle3 "counter-increment" [Ident "heading"] + style (Txt.resolve $ StyleTree textStyle4 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"])]) + + let textStyle5 = fromJust $ longhand temp textStyle4 "white-space" [Ident "normal"] + style (Txt.resolve $ StyleTree textStyle5 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])]) + + let textStyle6 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre"] + style (Txt.resolve $ StyleTree textStyle6 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "nowrap"])]) + + let textStyle7 = fromJust $ longhand temp textStyle4 "white-space" [Ident "nowrap"] + style (Txt.resolve $ StyleTree textStyle7 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "nowrap"])]) + + let textStyle8 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre-wrap"] + style (Txt.resolve $ StyleTree textStyle8 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])]) + + let textStyle9 = fromJust $ longhand temp textStyle4 "white-space" [Ident "pre-line"] + style (Txt.resolve $ StyleTree textStyle9 []) `shouldBe` + TrivialPropertyParser (fromList [("foo", [Ident "bar"]), ("white-space", [Ident "normal"])]) + + it "Inserts counters" $ do + let textStyle = temp :: Txt.TextStyle TrivialPropertyParser + shorthand textStyle "content" [Function "counter", Ident "-rhaps-ol", RightParen] `shouldBe` + [("content", [Function "counter", Ident "-rhaps-ol", RightParen])] + shorthand textStyle "content" [Function "counters", Ident "-rhaps-ol", Comma, String ".", RightParen] `shouldBe` + [("content", [Function "counters", Ident "-rhaps-ol", Comma, String ".", RightParen])] + styleIndex :: StyleIndex styleIndex = new queryable :: QueryableStyleSheet (VarParser TrivialPropertyParser) diff --git a/xml-conduit-stylist/src/Data/HTML2CSS.hs b/xml-conduit-stylist/src/Data/HTML2CSS.hs index 7020370..1102e17 100644 --- a/xml-conduit-stylist/src/Data/HTML2CSS.hs +++ b/xml-conduit-stylist/src/Data/HTML2CSS.hs @@ -103,9 +103,8 @@ stylize :: PropertyParser s => QueryableStyleSheet s -> StyleTree Element -> Sty stylize = preorder . stylize' stylize' :: PropertyParser s => QueryableStyleSheet s -> Maybe [(Txt.Text, s)] -> Maybe [(Txt.Text, s)] -> Element -> [(Txt.Text, s)] -stylize' stylesheet parent _ el = [ - (k, if Txt.null k then base else cascade' v [] base) - | (k, v) <- HM.toList $ queryRules stylesheet el +stylize' stylesheet parent _ el = ("", base) : [ + (k, cascade' v [] base) | (k, v) <- HM.toList $ queryRules stylesheet el ] where base = cascade stylesheet el overrides $ fromMaybe temp $ lookup "" =<< parent overrides = concat [fst $ parseProperties' $ tokenize $ Txt.pack val -- 2.30.2