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

M src/Data/CSS/Preprocessor/Text.hs
M src/Data/CSS/Preprocessor/Text/CounterStyle.hs

@@ 1,12 1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Lowers certain CSS properties to plain text.
-module Data.CSS.Preprocessor.Text(TextStyle, resolve) where
+module Data.CSS.Preprocessor.Text(TextStyle, resolve, CounterStore'(..)) where
 
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 import Data.CSS.Style (PropertyParser(..))
 import Data.CSS.StyleTree
 import qualified Data.Text as Txt
 import Data.Text (Text)
+import Data.CSS.Preprocessor.Text.CounterStyle (parseCounter, CounterStore'(..))
 
 import Data.Maybe (fromMaybe)
 import qualified Data.HashMap.Lazy as M


@@ 25,7 26,13 @@ data TextStyle p = TextStyle {
     counterSet :: Counters,
 
     whiteSpaceCollapse :: Bool,
-    newlineCollapse :: Bool
+    newlineCollapse :: Bool,
+
+    isListItem :: Bool,
+    listStyleImage :: [Token],
+    listStyleType :: [Token],
+    listPosInside :: Bool,
+    markerMatchParent :: Bool
 }
 
 instance PropertyParser p => PropertyParser (TextStyle p) where


@@ 36,7 43,12 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
             counterIncrement = [],
             counterSet = [],
             whiteSpaceCollapse = True,
-            newlineCollapse = True
+            newlineCollapse = True,
+            isListItem = False,
+            listStyleImage = [],
+            listStyleType = [Ident "disc"],
+            listPosInside = False,
+            markerMatchParent = False
         }
     inherit parent = TextStyle {
             inner = inherit $ inner parent,


@@ 45,7 57,12 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
             counterIncrement = [],
             counterSet = [],
             whiteSpaceCollapse = whiteSpaceCollapse parent,
-            newlineCollapse = newlineCollapse parent
+            newlineCollapse = newlineCollapse parent,
+            isListItem = False,
+            listStyleImage = listStyleImage parent,
+            listStyleType = listStyleType parent,
+            listPosInside = listPosInside parent,
+            markerMatchParent = markerMatchParent parent
         }
 
     shorthand _ key value


@@ 54,6 71,8 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
     shorthand self "white-space" [Ident val]
         | val `elem` ["normal", "pre", "pre-wrap", "pre-line"] = [("white-space", [Ident val])]
         | otherwise = shorthand (inner self) "white-space" [Ident val]
+    -- FIXME Handle "list-style" shorthand for -type, -image, & -position.
+    -- Needs helper util...
     shorthand TextStyle { inner = s } k v
         | Just _ <- longhand s s k $ removeCounters v = [(k, v)]
         | otherwise = shorthand s k v


@@ 69,8 88,47 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
     longhand p self "white-space" [Ident "pre-wrap"] = setWhiteSpace p self False False "normal"
     longhand p self "white-space" [Ident "pre-line"] = setWhiteSpace p self True False "normal"
 
+    longhand p self@TextStyle {inner=self'} "display" [Ident "list"] = Just self {
+        isListItem = True,
+        inner=fromMaybe self' $ longhand (inner p) self' "display" [Ident "block"]
+    }
+    longhand TextStyle {inner=p'} self@TextStyle {inner = self'} "display" value
+        | Just ret <- longhand p' self' "display" value = Just self {
+            isListItem = False,
+            inner = ret
+          }
+        | otherwise = Nothing
+
+    longhand _ self "list-style-image" [Ident kw] | kw `elem` ["initial", "none"]
+        = Just self { listStyleImage = [] }
+    longhand TextStyle { inner = p' } self@TextStyle { inner = self' }
+            "list-style-image" value
+        | Just _ <- longhand p' self' "background-image" value = Just self {
+            listStyleImage = value -- This is a valid image according to caller.
+          }
+        | otherwise = Nothing
+    longhand _ self "list-style-type" [Ident "initial"] =
+        Just self { listStyleType = [Ident "disc"] }
+    longhand _ self "list-style-type" toks | Just _ <- parseCounter M.empty toks =
+        Just self { listStyleType = toks }
+    longhand _ self "list-style-position" [Ident "inside"] =
+        Just self { listPosInside = True }
+    longhand _ self "list-style-position" [Ident "outside"] =
+        Just self { listPosInside = False }
+    longhand _ self "list-style-position" [Ident "initial"] =
+        Just self { listPosInside = False }
+    longhand _ self "marker-side" [Ident "match-self"] =
+        Just self { markerMatchParent = False }
+    longhand _ self "marker-side" [Ident "match-parent"] =
+        Just self { markerMatchParent = True }
+    longhand _ self "marker-side" [Ident "initial"] =
+        Just self { markerMatchParent = False }
+
     -- Capture `content` properties & anything else using counter(s) functions.
     -- This is important in Rhapsode for the sake of navigational markers.
+    -- Ignoring invalid properties.
+    longhand TextStyle { inner = p' } TextStyle { inner = self' } key value
+        | Nothing <- longhand p' self' key $ removeCounters value = Nothing
     longhand parent self key value
         | key == "content" || Function "counter" `elem` value || Function "counters" `elem` value =
             Just $ self { counterProps = insertList key value $ counterProps self }

@@ 171,10 171,7 @@ parseCounterStyle store (Ident name:toks)
                     HM.lookupDefault decimalCounter name' store
                 _ -> defaultCounter
             style = foldr (parseCounterProperty store) super props
-        in (
-            if isValid style then HM.insert name style store else store,
-            toks'
-        )
+        in (HM.insert name style store, toks')
 parseCounterStyle store toks = (store, skipAtRule toks)
 
 parseSymbol :: Token -> Maybe Text


@@ 355,7 352,8 @@ parseCounter _ (Function "symbols":Ident name:toks)
     parseArgs (RightParen:toks') = Just ([],toks')
     parseArgs _ = Nothing
 parseCounter store (Ident name:toks)
-    | Just ret <- HM.lookup name store = Just (ret, toks)
+    | Just ret <- HM.lookup name store, isValid ret = Just (ret, toks)
+    | otherwise = Just (decimalCounter, toks)
 parseCounter _ (String sym:toks) =
     Just (defaultCounter {system = Cyclic, symbols = [sym], suffix = " "}, toks)
 parseCounter _ _ = Nothing