2 files changed, 81 insertions(+), 9 deletions(-)

M src/Data/CSS/Preprocessor/Text.hs
M stylist.cabal

@@ 1,20 1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Lowers certain CSS properties to plain text.
-module Data.CSS.Preprocessor.Text(TextStyle, resolve) where
+module Data.CSS.Preprocessor.Text(TextStyle, resolve, StyleTree(..)) where
 
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 import Data.CSS.Style (PropertyParser(..))
-import Data.Text
+import Data.CSS.StyleTree
+import qualified Data.Text as Txt
+import Data.Text (Text)
+
 import Data.Maybe (fromMaybe)
+import qualified Data.HashMap.Lazy as M
+import Data.Function ((&))
 
+type Counters = [(Text, Integer)]
 -- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text.
 data TextStyle p = TextStyle {
     inner :: p,
     content :: [Token],
 
-    counterReset :: [(Text, Integer)],
-    counterIncrement :: [(Text, Integer)],
-    counterSet :: [(Text, Integer)]
+    counterReset :: Counters,
+    counterIncrement :: Counters,
+    counterSet :: Counters
 }
 
 instance PropertyParser p => PropertyParser (TextStyle p) where


@@ 59,6 65,72 @@ parseCounters x (Ident counter : Number _ (NVInteger count') : toks) =
 parseCounters x (Ident counter : toks) = (:) (counter, x) <$> parseCounters x toks
 parseCounters _ _ = Nothing
 
-resolve :: PropertyParser p => TextStyle p -> p
-resolve TextStyle {inner = inner', content = content'} =
-    fromMaybe inner' $ longhand temp inner' "content" content'
+resolve :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
+resolve = applyCounters
+
+--------
+---- Counters
+--------
+type Context = M.HashMap Text [([Integer], Integer)]
+
+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 counters path name val = M.insertWith appendCounter name [(path, val)] counters
+    where
+        appendCounter new (old@((_:oldPath), _):olds)
+            | oldPath == tail path = new ++ olds
+            | otherwise =  new ++ (old:olds)
+        appendCounter new [] = new
+        appendCounter new (_:olds) = new ++ olds
+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 counters path name val = M.insertWith addCounter name [(path, val)] counters
+    where
+        addCounter ((_, new):_) ((path', old):rest) = (path', new + old):rest
+        addCounter [] old = old
+        addCounter new [] = new
+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 counters path name val = M.insertWith setCounter' name [(path, val)] counters
+    where
+        setCounter' ((_, val'):_) ((path', _):rest) = (path', val'):rest
+        setCounter' [] old = old
+        setCounter' new [] = new
+setCounters :: Path -> Counters -> Context -> Context
+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)
+    | 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)
+    | 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 :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
+applyCounters = treeOrder applyCounters0 M.empty
+applyCounters0 :: PropertyParser p => Context -> Context -> Path -> TextStyle p -> (Context, p)
+applyCounters0 counterSource valueSource path node =
+    let counters = inheritCounters counterSource valueSource &
+            instantiateCounters path (counterReset node) &
+            incrementCounters path (counterIncrement node) &
+            setCounters path (counterSet node)
+    in let inner' = inner node
+    in (counters,
+        fromMaybe inner' $ longhand temp inner' "content" $ renderCounters counters $ content node)

@@ 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.Style, Data.CSS.StyleTree,
                        Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr,
                        Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text