M src/Data/CSS/Preprocessor/Text.hs => src/Data/CSS/Preprocessor/Text.hs +76 -27
@@ 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]
})
--------
M src/Data/CSS/Preprocessor/Text/CounterStyle.hs => src/Data/CSS/Preprocessor/Text/CounterStyle.hs +11 -3
@@ 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
M stylist.cabal => stylist.cabal +4 -3
@@ 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