@@ 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
@@ 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,
@@ 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)