From 4d148074125e584a21eb4d9771994e091afb1738 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 26 Apr 2023 13:04:51 +1200 Subject: [PATCH] Unit tests & bug fixes for counter-renderers. --- .../CSS/Preprocessor/Text/CounterStyle.hs | 131 ++++++++++-------- .../CSS/Preprocessor/Text/counter-styles.css | 10 +- stylist.cabal | 6 +- test/Test.hs | 68 +++++++++ 4 files changed, 149 insertions(+), 66 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs index 13eafef..eda73f0 100644 --- a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs +++ b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs @@ -1,14 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module Data.CSS.Preprocessor.Text.CounterStyle(CounterStyle(..), CounterSystem(..), - defaultCounter, decimalCounter, isValid, parseCounter, CounterStore'(..), + defaultCounter, decimalCounter, isValid, parseCounterStyle, CounterStore'(..), counterRender, ranges', speakAs', parseCounter) where import Data.CSS.Syntax.Tokens import Data.CSS.Syntax.StyleSheet -import Data.Text as Txt (Text, unpack) -import Data.HashMap.Lazy as HM +import qualified Data.Text as Txt +import Data.Text (Text, unpack) +import qualified Data.HashMap.Lazy as HM +import Data.HashMap.Lazy (HashMap) import Data.Maybe (isJust, fromJust) -import Data.List (foldl') + +import Debug.Trace (traceShow) -- NOTE: No support for image "symbols" yet. data CounterStyle = CounterStyle { @@ -28,6 +31,7 @@ data CounterStyle = CounterStyle { data CounterSystem = Cyclic | Fixed Int | Symbolic | Alphabetic | Numeric | Additive +defaultCounter, decimalCounter :: CounterStyle defaultCounter = CounterStyle { system = Symbolic, negativePrefix = "-", @@ -69,11 +73,11 @@ parseCounterProperty _ ("system", [Ident "numeric"]) self = -- Handled by caller so property overrides work correctly. parseCounterProperty _ ("system", [Ident "extends", Ident _]) self = self -parseCounterProperty _ ("negative", [x]) self | Just prefix <- parseSymbol x = - self { negativePrefix = prefix, negativeSuffix = "" } +parseCounterProperty _ ("negative", [x]) self | Just pre <- parseSymbol x = + self { negativePrefix = pre, negativeSuffix = "" } parseCounterProperty _ ("negative", [x, y]) self - | Just prefix <- parseSymbol x, Just suffix <- parseSymbol y = - self { negativePrefix = prefix, negativeSuffix = suffix } + | Just pre <- parseSymbol x, Just suf <- parseSymbol y = + self { negativePrefix = pre, negativeSuffix = suf } parseCounterProperty _ ("prefix", [x]) self | Just pre <- parseSymbol x = self { prefix = pre } @@ -81,8 +85,8 @@ parseCounterProperty _ ("suffix", [x]) self | Just suf <- parseSymbol x = self { suffix = suf } parseCounterProperty _ ("range", [Ident "auto"]) self = self {ranges = Nothing} -parseCounterProperty _ (("range", toks):props) self - | Just rs <- parseRanges (Comma:toks) = self { ranges = Just rs } +parseCounterProperty _ ("range", toks) self | Just rs <- parseRanges (Comma:toks) = + self { ranges = Just rs } parseCounterProperty _ ("pad", [Number _ (NVInteger x), y]) self | Just char <- parseSymbol y = self { @@ -97,16 +101,17 @@ parseCounterProperty _ ("additive-symbols", toks) self | Just syms <- parseAdditiveSymbols (Comma:toks) = self { additiveSymbols = syms } -parseCounterProperty _ ("speak-as", Ident "auto") self = +parseCounterProperty _ ("speak-as", [Ident "auto"]) self = self { speakAs = Nothing } -parseCounterProperty styles ("speak-as", Ident x) self +parseCounterProperty styles ("speak-as", [Ident x]) self | x `elem` ["bullets", "numbers", "words", "spell-out"] = self { speakAs = Just x } | Just super <- HM.lookup x styles = self { speakAs = speakAs super } | otherwise = self parseCounterProperty _ _ self = self -parseRanges (Comma:x:y:toks) | Just self <- parseRanges toks = case (x, y) of +parseRanges :: [Token] -> Maybe [(Int, Int)] +parseRanges (Comma:a:b:toks) | Just self <- parseRanges toks = case (a, b) of (Ident "infinite", Ident "infinite") -> Just ((minBound, maxBound):self) (Ident "infinite", Number _ (NVInteger x)) -> Just ((minBound, fromInteger x):self) @@ -118,34 +123,39 @@ parseRanges (Comma:x:y:toks) | Just self <- parseRanges toks = case (x, y) of parseRanges [] = Just [] parseRanges _ = Nothing -parseAdditiveSymbols (Comma:Number _ (NumericInteger x):y:toks) - | Just self <- parseRanges toks, Just sym <- parseSymbol y = - Just ((fromInteger x, y):self) +parseAdditiveSymbols :: [Token] -> Maybe [(Int, Text)] +parseAdditiveSymbols (Comma:Number _ (NVInteger x):y:toks) + | Just self <- parseAdditiveSymbols toks, Just sym <- parseSymbol y = + Just ((fromInteger x, sym):self) parseAdditiveSymbols [] = Just [] parseAdditiveSymbols _ = Nothing -parseCounter :: CounterStore -> [Token] -> (CounterStore, [Token]) -parseCounter store (Whitespace:toks) = parseCounter store toks -parseCounter store (Ident name:toks) - | Just ((props, ""), tail) <- parseProperties toks = +parseCounterStyle :: CounterStore -> [Token] -> (CounterStore, [Token]) +parseCounterStyle store (Whitespace:toks) = parseCounterStyle store toks +parseCounterStyle store (Ident name:toks) + | ((props, ""), toks') <- parseProperties toks = let super = case Prelude.lookup "system" props of - [Ident "extends", Ident name'] -> + Just [Ident "extends", Ident name'] -> HM.lookupDefault decimalCounter name' store _ -> defaultCounter style = foldr (parseCounterProperty store) super props - in if isValid style then HM.insert name style store else store -parseCounter store toks = (store, skipAtRule toks) + in ( + if isValid style then HM.insert name style store else store, + toks' + ) +parseCounterStyle store toks = (store, skipAtRule toks) parseSymbol :: Token -> Maybe Text parseSymbol (Ident x) = Just x parseSymbol (String x) = Just x +parseSymbol _ = Nothing data CounterStore' = CounterStore { unwrap :: CounterStore } instance StyleSheet CounterStore' where addRule self _ = self addAtRule (CounterStore self) "counter-style" toks = - let (self', tail) = parseCounter self toks - in (CounterStore self', tail) + let (self', toks') = parseCounterStyle self toks + in (CounterStore self', toks') addAtRule self _ toks = (self, skipAtRule toks) --- @@ -155,63 +165,66 @@ fallbackSym = "\0" counterRenderCore :: CounterStyle -> Int -> Text counterRenderCore CounterStyle { system = Cyclic, symbols = syms } x = - syms !! rem x (length syms) + syms !! (pred x `rem` length syms) counterRenderCore CounterStyle { system = Fixed n, symbols = syms } x | x - n < length syms = syms !! (x - n) | otherwise = fallbackSym counterRenderCore CounterStyle { system = Symbolic, symbols = syms } x = - quot x n `Txt.replicate` (syms !! rem x n) - where n = length syms + succ (quot x' n) `Txt.replicate` (syms !! rem x' n) + where (n, x') = (length syms, pred x) counterRenderCore CounterStyle { system = Alphabetic, symbols = syms } x = inner x where n = length syms inner 0 = "" - inner x = let x' = pred x in (syms !! rem x' n) `Txt.append` inner (quot x' n) + inner y = let x' = pred y in inner (quot x' n) `Txt.append` (syms !! rem x' n) counterRenderCore CounterStyle { system = Numeric, symbols = syms } 0 = syms !! 0 counterRenderCore CounterStyle { system = Numeric, symbols = syms } x = inner x where n = length syms inner 0 = "" - inner x = (syms !! rem x n) `Txt.append` inner (quot x n) + inner y = inner (quot y n) `Txt.append` (syms !! rem y n) counterRenderCore CounterStyle { system = Additive, additiveSymbols = syms } 0 - | Just sym <- Prelude.lookup 0 syms = s `Txt.append` sym + | Just sym <- Prelude.lookup 0 syms = sym | otherwise = fallbackSym -counterRenderCore CounterStyle { system = Additive, additiveSymbols = syms } w = - | '\0' `Txt.elem` inner syms w = fallbackSym +counterRenderCore CounterStyle { system = Additive, additiveSymbols = syms } w + | '\0' `elem'` inner syms w = fallbackSym | otherwise = inner syms w where + elem' ch txt = elem ch $ unpack txt inner _ 0 = "" - inner ((0, _):syms) x = inner syms x - inner ((weight, _):syms) x | weight > x = inner syms x - inner ((weight, sym):syms) x = - Txt.replicate reps sym `Txt.append` inner syms x' + inner ((0, _):syms') x = inner syms' x + inner ((weight, _):syms') x | weight > x = inner syms' x + inner ((weight, sym):syms') x = + Txt.replicate reps sym `Txt.append` inner syms' x' where reps = quot x weight x' = x - weight * reps - inner [] x = "\0" -- Run fallback counter! + inner [] _ = "\0" -- Run fallback counter! counterRender :: CounterStyle -> Int -> Text counterRender self x - | x < 0 = Txt.concat [prefix self, negativePrefix self, inner self -x, + | x < 0 = Txt.concat [prefix self, negativePrefix self, inner self $ -x, negativeSuffix self, suffix self] | otherwise = Txt.concat [prefix self, inner self x, suffix self] where - inner self@CounterStyle { fallback = Just self' } x - | not $ inRange x $ ranges' self = inner self' x - | counterRenderCore self x == fallbackSym = inner self' x - inner self x - | text == fallbackSym = show x -- NOTE: Shouldn't happen - | n < padLength self = - (padLength self - n `Txt.replicate` padChar self) `Txt.append` text + inner :: CounterStyle -> Int -> Text + inner this@CounterStyle { fallback = Just self' } x' + | not $ inRange x $ ranges' this = inner self' x' + | counterRenderCore this x == fallbackSym = inner self' x' + inner self' x' + | text == fallbackSym = Txt.pack $ show x' -- NOTE: Shouldn't happen + | n < padLength self' = + Txt.replicate (padLength self' - n) (padChar self') `Txt.append` text | otherwise = text where - text = counterRenderCore self x + text = counterRenderCore self' x' n = Txt.length text - inRange ((start, end):ranges) x - | x >= start && x <= end = True - | otherwise = inRange ranges x - inRange [] _ = False + inRange y ((start, end):rest) + | y >= start && y <= end = True + | otherwise = inRange y rest + inRange _ [] = False +infiniteRange :: [(Int, Int)] infiniteRange = [(minBound, maxBound)] ranges' :: CounterStyle -> [(Int, Int)] ranges' CounterStyle { ranges = Just ret } = ret @@ -230,20 +243,20 @@ speakAs' _ = "numbers" --- -parseCounter :: CounterStore -> [Token] -> (CounterStyle, [Token]) -parseCounter _ (Func "symbols":Ident system:toks) - | Just system' <- Prelude.lookup system [ +parseCounter :: CounterStore -> [Token] -> Maybe (CounterStyle, [Token]) +parseCounter _ (Function "symbols":Ident name:toks) + | Just system' <- Prelude.lookup name [ ("cyclic", Cyclic), ("numeric", Numeric), ("alphabetic", Alphabetic), ("symbolic", Symbolic), ("fixed", Fixed 1) ], Just (syms, toks') <- parseArgs toks = - Just (defaultCounter{ system = system', symbols = syms }, tail) + Just (defaultCounter { system = system', symbols = syms }, toks') where - parseArgs (String sym:toks) | Just (syms,tail) <- parseArgs toks = - Just (sym:syms, tail) - parseArgs (RightParen:toks) = Just ([],toks) + parseArgs (String sym:toks') | Just (syms,tail') <- parseArgs toks' = + Just (sym:syms, tail') + parseArgs (RightParen:toks') = Just ([],toks') parseArgs _ = Nothing parseCounter store (Ident name:toks) | Just ret <- HM.lookup name store = Just (ret, toks) parseCounter _ (String sym:toks) = - Just (defaultCounter { system = Symbolic, syms = [sym], suffix = " " }, toks) + Just (defaultCounter { system = Symbolic, symbols = [sym], suffix = " " }, toks) parseCounter _ _ = Nothing diff --git a/src/Data/CSS/Preprocessor/Text/counter-styles.css b/src/Data/CSS/Preprocessor/Text/counter-styles.css index 63bb914..e219cc8 100644 --- a/src/Data/CSS/Preprocessor/Text/counter-styles.css +++ b/src/Data/CSS/Preprocessor/Text/counter-styles.css @@ -1,26 +1,26 @@ /* Bullets */ @counter-style none { - system: symbolic; + system: cyclic; symbols: ""; suffix: " " } @counter-style disc { - system: symbolic; + system: cyclic; symbols: "•"; suffix: " "; } @counter-style circle { - system: symbolic; + system: cyclic; symbols: "◦"; suffix: " "; } @counter-style disclosure-open { - system: symbolic; + system: cyclic; symbols: "▾"; suffix: " "; } @counter-style disclosure-closed { - system: symbolic; + system: cyclic; /* FIXME: It'd proper to consider text-direction in selecting this marker. */ symbols: "▸"; suffix: " " diff --git a/stylist.cabal b/stylist.cabal index 52618bd..1cf3328 100644 --- a/stylist.cabal +++ b/stylist.cabal @@ -56,7 +56,8 @@ library exposed-modules: Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style, Data.CSS.StyleTree, Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr, - Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.PsuedoClasses + Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.PsuedoClasses, + Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.Text.CounterStyle -- Modules included in this library but not exported. other-modules: Data.CSS.Style.Importance, Data.CSS.Style.Common, Data.CSS.Style.Cascade, @@ -83,7 +84,8 @@ library test-suite test-stylist other-modules: - Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr, Data.CSS.Preprocessor.Text, + Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr, + Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.Text.CounterStyle, Data.CSS.Style.Cascade, Data.CSS.Style.Common, Data.CSS.Style.Importance, Data.CSS.Style.Selector.Index, Data.CSS.Style.Selector.Interpret, Data.CSS.Style.Selector.LowerWhere, Data.CSS.Style.Selector.Specificity, diff --git a/test/Test.hs b/test/Test.hs index 1bb5c0d..5f2e8e0 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -24,6 +24,8 @@ import Data.CSS.Preprocessor.Conditions import Data.CSS.Preprocessor.Conditions.Expr (Datum(..), Op(..), parse', eval) import qualified Data.CSS.Preprocessor.Text as Txt +import qualified Data.CSS.Preprocessor.Text.CounterStyle as Ctr + main :: IO () main = hspec spec @@ -520,6 +522,72 @@ spec = do layerPath ["LeagueOfGentlemenAdventurers"] tree5 `shouldBe` [1] uniqueName ["HomeTeam"] tree5 `shouldBe` ["HomeTeam", "1"] + describe "@counter-style" $ do + -- NOTE: Thes are mostly based on examples given in the spec + -- https://w3c.github.io/csswg-drafts/css-counter-styles-3/#counter-style-system + it "Handles system: cyclic" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Cyclic, Ctr.symbols = ["!", "@", "#"] + } + Ctr.counterRender counter 2 `shouldBe` "@. " + Ctr.counterRender counter 4 `shouldBe` "!. " + it "Handles system: fixed" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Fixed 1, Ctr.symbols = ["◰", "◳", "◲", "◱"], + Ctr.suffix = ": " + } + Ctr.counterRender counter 1 `shouldBe` "◰: " + Ctr.counterRender counter 2 `shouldBe` "◳: " + Ctr.counterRender counter 3 `shouldBe` "◲: " + Ctr.counterRender counter 4 `shouldBe` "◱: " + Ctr.counterRender counter 5 `shouldBe` "5: " + Ctr.counterRender counter 6 `shouldBe` "6: " + it "Handles system: symbolic" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Symbolic, Ctr.symbols = ["*", "⁑", "†", "‡"], + Ctr.suffix = " " + } + Ctr.counterRender counter 1 `shouldBe` "* " + Ctr.counterRender counter 2 `shouldBe` "⁑ " + Ctr.counterRender counter 3 `shouldBe` "† " + Ctr.counterRender counter 4 `shouldBe` "‡ " + Ctr.counterRender counter 5 `shouldBe` "** " + Ctr.counterRender counter 6 `shouldBe` "⁑⁑ " + it "Handles system: alphabetic" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Alphabetic, Ctr.symbols = ["◦", "•"], + Ctr.suffix = " " + } + Ctr.counterRender counter 1 `shouldBe` "◦ " + Ctr.counterRender counter 2 `shouldBe` "• " + Ctr.counterRender counter 3 `shouldBe` "◦◦ " + Ctr.counterRender counter 4 `shouldBe` "◦• " + Ctr.counterRender counter 5 `shouldBe` "•◦ " + Ctr.counterRender counter 6 `shouldBe` "•• " + Ctr.counterRender counter 7 `shouldBe` "◦◦◦ " + it "Handles system: numeric" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Numeric, Ctr.symbols = ["0", "1", "2"] + } + Ctr.counterRender counter 1 `shouldBe` "1. " + Ctr.counterRender counter 2 `shouldBe` "2. " + Ctr.counterRender counter 3 `shouldBe` "10. " + Ctr.counterRender counter 4 `shouldBe` "11. " + Ctr.counterRender counter 5 `shouldBe` "12. " + Ctr.counterRender counter 6 `shouldBe` "20. " + it "Handles system: additive" $ do + let counter = Ctr.defaultCounter { + Ctr.system = Ctr.Additive, Ctr.suffix = " ", + Ctr.additiveSymbols = [(6, "⚅"), (5, "⚄"), (4, "⚃"), + (3, "⚂"), (2, "⚁"), (1, "⚀")] + } + Ctr.counterRender counter 1 `shouldBe` "⚀ " + Ctr.counterRender counter 2 `shouldBe` "⚁ " + Ctr.counterRender counter 3 `shouldBe` "⚂ " + Ctr.counterRender counter 11 `shouldBe` "⚅⚄ " + Ctr.counterRender counter 12 `shouldBe` "⚅⚅ " + Ctr.counterRender counter 13 `shouldBe` "⚅⚅⚀ " + styleIndex :: StyleIndex styleIndex = new queryable :: QueryableStyleSheet (VarParser TrivialPropertyParser) -- 2.30.2