From 30021fd13a6232b62a9b0c99a3c80f34a5902517 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 1 May 2023 13:44:27 +1200 Subject: [PATCH] Implement counter-styles into counters infrastructure. --- src/Data/CSS/Preprocessor/Text.hs | 103 +++++++++++++----- .../CSS/Preprocessor/Text/CounterStyle.hs | 14 ++- stylist.cabal | 7 +- 3 files changed, 91 insertions(+), 33 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Text.hs b/src/Data/CSS/Preprocessor/Text.hs index 135987b..193f6c8 100644 --- a/src/Data/CSS/Preprocessor/Text.hs +++ b/src/Data/CSS/Preprocessor/Text.hs @@ -1,13 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} -- | Lowers certain CSS properties to plain text. -module Data.CSS.Preprocessor.Text(TextStyle, resolve, CounterStore'(..)) where +module Data.CSS.Preprocessor.Text( + TextStyle, resolve, resolveWithCounterStyles, CounterStore'(..)) where import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) import Stylist (parseUnorderedShorthand, PropertyParser(..)) +import Stylist.Parse (scanBlock) import Data.CSS.StyleTree import qualified Data.Text as Txt import Data.Text (Text) -import Data.CSS.Preprocessor.Text.CounterStyle (parseCounter, CounterStore'(..)) +import Data.CSS.Preprocessor.Text.CounterStyle + (parseCounter, CounterStore'(..), defaultCounterStore, decimalCounter, + counterRender, counterRenderMarker, CounterStore, CounterStyle) import Data.Maybe (fromMaybe) import qualified Data.HashMap.Lazy as M @@ -15,7 +19,7 @@ import Data.Function ((&)) import Data.Char (isSpace) -type Counters = [(Text, Integer)] +type Counters = [(Text, Int)] -- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text. data TextStyle p = TextStyle { inner :: p, @@ -140,43 +144,72 @@ insertList key value list | Nothing <- lookup key list = (key, value) : list removeCounters :: [Token] -> [Token] removeCounters (Function "counter":Ident _:RightParen:toks) = String "" : removeCounters toks -removeCounters (Function "counters":Ident _:Comma:String _:toks) = String "" : removeCounters toks +removeCounters (Function "counter":Ident _:Comma:toks) + | Just (_, RightParen:toks') <- parseCounter0 toks = String "" : removeCounters toks' +removeCounters (Function "counters":Ident _:Comma:String _:RightParen:toks) = + String "" : removeCounters toks +removeCounters (Function "counters":Ident _:Comma:String _:Comma:toks) + | Just (_, RightParen:toks') <- parseCounter0 toks = String "" : removeCounters toks' removeCounters (tok:toks) = tok : removeCounters toks removeCounters [] = [] +parseCounter0 :: [Token] -> Maybe (CounterStyle, [Token]) +parseCounter0 = parseCounter M.empty + setWhiteSpace :: PropertyParser p => TextStyle p -> TextStyle p -> Bool -> Bool -> Text -> Maybe (TextStyle p) setWhiteSpace parent self collapse noNewlines lowered = Just $ self { inner = inner self `fromMaybe` longhand (inner parent) (inner self) "white-space" [Ident lowered], whiteSpaceCollapse = collapse, newlineCollapse = noNewlines } -parseCounters :: Integer -> [Token] -> Maybe [(Text, Integer)] +parseCounters :: Int -> [Token] -> Maybe [(Text, Int)] parseCounters _ [Ident "none"] = Just [] parseCounters _ [Ident "initial"] = Just [] parseCounters _ [] = Just [] parseCounters x (Ident counter : Number _ (NVInteger count') : toks) = - (:) (counter, count') <$> parseCounters x toks + (:) (counter, fromIntegral count') <$> parseCounters x toks parseCounters x (Ident counter : toks) = (:) (counter, x) <$> parseCounters x toks parseCounters _ _ = Nothing -- | Returns inner `PropertyParser` with text properties applied. resolve :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p -resolve = resolve' . collapseWS . applyCounters +resolve = resolveWithCounterStyles defaultCounterStore +resolveWithCounterStyles :: PropertyParser p => + CounterStore' -> StyleTree (TextStyle p) -> StyleTree p +resolveWithCounterStyles (CounterStore counters) = + resolve' . collapseWS . applyCounters counters resolve' :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p resolve' = treeMap $ \TextStyle {inner = inner', counterProps = props} -> foldl resolveProp inner' props resolveProp :: PropertyParser p => p -> (Text, [Token]) -> p resolveProp sty (key, value) = sty `fromMaybe` longhand temp sty key value +-------- +---- Lists +-------- + +-- Needs the "marker" pseudo-element. How should I implement pseudo-elements? +-- Currently I've got a pre-processor which inserts the ::before & ::after +-- pseudo-elements. +-- To feed that data in I'd need to alter the API. +-- I could add an extra function here. +-- I could extend the PropertyParser to have a method each pseudo-element is +-- fed to. That is more likely to aid later requirements. And if I alter the +-- `cascade'` function to seperate parent & base styles that could aid interactive +-- pseudoclasses! The method could call `cascade'` or `cascadeExtend` to +-- generate values to be stored. +-- I think I'll go for the latter option, though I'd still need the former to +-- access the counter-styles. + -------- ---- Counters -------- -type Context = M.HashMap Text [([Integer], Integer)] +type Context = M.HashMap Text [([Integer], Int)] inheritCounters :: Context -> Context -> Context inheritCounters counterSource valueSource = M.intersectionWith cb valueSource counterSource -- indexed by name & el-path where cb val source = [counter | counter@(path, _) <- val, path `elem` [p | (p, _) <- source]] -instantiateCounter :: Context -> Path -> Text -> Integer -> Context +instantiateCounter :: Context -> Path -> Text -> Int -> Context instantiateCounter counters path name val = M.insertWith appendCounter name [(path, val)] counters where appendCounter new (old@((_:oldPath), _):olds) @@ -188,7 +221,7 @@ instantiateCounters :: Path -> Counters -> Context -> Context instantiateCounters path instruct counters = foldl cb counters instruct where cb counters' (name, value) = instantiateCounter counters' path name value -incrementCounter :: Context -> Path -> Text -> Integer -> Context +incrementCounter :: Context -> Path -> Text -> Int -> Context incrementCounter counters path name val = M.insertWith addCounter name [(path, val)] counters where addCounter ((_, new):_) ((path', old):rest) = (path', new + old):rest @@ -198,7 +231,7 @@ incrementCounters :: Path -> Counters -> Context -> Context incrementCounters path instruct counters = foldl cb counters instruct where cb counters' (name, value) = incrementCounter counters' path name value -setCounter :: Context -> Path -> Text -> Integer -> Context +setCounter :: Context -> Path -> Text -> Int -> Context setCounter counters path name val = M.insertWith setCounter' name [(path, val)] counters where setCounter' ((_, val'):_) ((path', _):rest) = (path', val'):rest @@ -209,29 +242,45 @@ setCounters path instruct counters = foldl cb counters instruct where cb counters' (name, value) = setCounter counters' path name value -renderCounters :: Context -> [Token] -> [Token] -renderCounters counters (Function "counter":Ident name:RightParen:toks) +renderCounters :: CounterStore -> Context -> [Token] -> [Token] +renderCounters store counters (Function "counter":Ident name:RightParen:toks) | Just ((_, count):_) <- name `M.lookup` counters = - String (Txt.pack $ show count) : renderCounters counters toks - | otherwise = renderCounters counters toks -renderCounters counters (Function "counters":Ident name:Comma:String sep:RightParen:toks) + String (counterRender decimalCounter count) : renderCounters store counters toks + | otherwise = renderCounters store counters toks +renderCounters store counters (Function "counter":Ident name:Comma:toks) + | Just ((_, count):_) <- name `M.lookup` counters, + Just (cstyle, RightParen:toks') <- parseCounter store toks = + String (counterRender cstyle count) : renderCounters store counters toks' + | otherwise = renderCounters store counters $ skipBlock toks +renderCounters store counters (Function "counters":Ident name:Comma:String sep:RightParen:toks) | Just counter <- name `M.lookup` counters = String (Txt.intercalate sep [ - Txt.pack $ show count | (_, count) <- reverse counter - ]) : renderCounters counters toks - | otherwise = renderCounters counters toks -renderCounters counters (tok:toks) = tok : renderCounters counters toks -renderCounters _ [] = [] - -applyCounters :: StyleTree (TextStyle p) -> StyleTree (TextStyle p) -applyCounters = treeOrder applyCounters0 M.empty -applyCounters0 :: Context -> Context -> Path -> TextStyle p -> (Context, TextStyle p) -applyCounters0 counterSource valueSource path node = + counterRender decimalCounter count | (_, count) <- reverse counter + ]) : renderCounters store counters toks + | otherwise = renderCounters store counters toks +renderCounters store counters (Function "counters":Ident name:Comma:String sep:Comma:toks) + | Just counter <- name `M.lookup` counters, + Just (cstyle, RightParen:toks') <- parseCounter store toks = + String (Txt.intercalate sep [ + counterRender cstyle count | (_, count) <- reverse counter + ]) : renderCounters store counters toks' + | otherwise = renderCounters store counters toks +renderCounters store counters (tok:toks) = tok : renderCounters store counters toks +renderCounters _ _ [] = [] + +skipBlock :: [Token] -> [Token] +skipBlock = snd . scanBlock + +applyCounters :: CounterStore -> StyleTree (TextStyle p) -> StyleTree (TextStyle p) +applyCounters counters = treeOrder (applyCounters0 counters) M.empty +applyCounters0 :: CounterStore -> Context -> Context -> Path -> TextStyle p -> + (Context, TextStyle p) +applyCounters0 store counterSource valueSource path node = let counters = inheritCounters counterSource valueSource & instantiateCounters path (counterReset node) & incrementCounters path (counterIncrement node) & setCounters path (counterSet node) in (counters, node { - counterProps = [(k, renderCounters counters v) | (k, v) <- counterProps node] + counterProps = [(k, renderCounters store counters v) | (k, v) <- counterProps node] }) -------- diff --git a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs index 0fd35f3..3e08362 100644 --- a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs +++ b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} module Data.CSS.Preprocessor.Text.CounterStyle(CounterStyle(..), CounterSystem(..), defaultCounter, decimalCounter, simpChineseInformal, cjkDecimal, ethiopic, - isValid, parseCounterStyle, CounterStore'(..), parseCounter, - counterRender, counterRenderMarker, ranges', speakAs') where + isValid, parseCounterStyle, CounterStore'(..), parseCounter, defaultCounterStore, + counterRender, counterRenderMarker, ranges', speakAs', CounterStore) where import Data.CSS.Syntax.Tokens import Data.CSS.Syntax.StyleSheet +import Data.FileEmbed (embedStringFile, makeRelativeToProject) + import qualified Data.Text as Txt import Data.Text (Text, unpack) import qualified Data.HashMap.Lazy as HM @@ -187,6 +189,12 @@ instance StyleSheet CounterStore' where in (CounterStore self', toks') addAtRule self _ toks = (self, skipAtRule toks) +defaultCounterStore :: CounterStore' +defaultCounterStore = + parse (CounterStore HM.empty) $ Txt.pack + $(makeRelativeToProject "src/Data/CSS/Preprocessor/Text/counter-styles.css" >>= + embedStringFile) + --- fallbackSym :: Text diff --git a/stylist.cabal b/stylist.cabal index 77d6615..dc75a0d 100644 --- a/stylist.cabal +++ b/stylist.cabal @@ -54,7 +54,7 @@ source-repository head library -- Modules exported by the library. exposed-modules: Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, - Data.CSS.Style, Data.CSS.StyleTree, Data.CSS.ShorthandUtil, + Data.CSS.Style, Data.CSS.StyleTree, Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr, Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.PsuedoClasses, Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.Text.CounterStyle @@ -72,7 +72,8 @@ library build-depends: base >=4.9 && <5, css-syntax >=0.1 && <0.2, text, unordered-containers >= 0.2 && <0.3, hashable, network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3, - regex-tdfa >= 1.3, stylist-traits >= 0.1 && < 0.2 + regex-tdfa >= 1.3, stylist-traits >= 0.1.2 && < 0.2, + file-embed >= 0.0.10 && < 0.1 -- Directories containing source files. hs-source-dirs: src @@ -99,5 +100,5 @@ test-suite test-stylist build-depends: base >=4.9 && <5, css-syntax >=0.1 && <0.2, text, unordered-containers >= 0.2 && <0.3, hashable, network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3, - regex-tdfa >= 1.3, hspec, QuickCheck, + regex-tdfa >= 1.3, hspec, QuickCheck, file-embed, scientific >= 0.3 && <1.0, regex-tdfa >= 1.3, stylist-traits >= 0.1 && < 0.2 -- 2.30.2