1 files changed, 89 insertions(+), 20 deletions(-)

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

@@ 10,8 10,8 @@ import Data.CSS.StyleTree
 import qualified Data.Text as Txt
 import Data.Text (Text)
 import Data.CSS.Preprocessor.Text.CounterStyle
-        (parseCounter, CounterStore'(..), defaultCounterStore, decimalCounter,
-        counterRender, counterRenderMarker, CounterStore, CounterStyle)
+        (parseCounter, counterRender, CounterStore'(..), decimalCounter,
+        defaultCounterStore, CounterStore, CounterStyle(..))
 
 import Data.Maybe (fromMaybe)
 import qualified Data.HashMap.Lazy as M


@@ 36,7 36,11 @@ data TextStyle p = TextStyle {
     listStyleImage :: [Token],
     listStyleType :: [Token],
     listPosInside :: Bool,
-    markerMatchParent :: Bool
+    markerMatchParent :: Bool,
+
+    beforePseudo :: Maybe (TextStyle p),
+    afterPseudo  :: Maybe (TextStyle p),
+    markerPseudo :: Maybe (TextStyle p)
 }
 
 instance PropertyParser p => PropertyParser (TextStyle p) where


@@ 52,7 56,10 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
             listStyleImage = [],
             listStyleType = [Ident "disc"],
             listPosInside = False,
-            markerMatchParent = False
+            markerMatchParent = False,
+            beforePseudo = Nothing,
+            afterPseudo  = Nothing,
+            markerPseudo = Nothing
         }
     inherit parent = TextStyle {
             inner = inherit $ inner parent,


@@ 66,7 73,10 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
             listStyleImage = listStyleImage parent,
             listStyleType = listStyleType parent,
             listPosInside = listPosInside parent,
-            markerMatchParent = markerMatchParent parent
+            markerMatchParent = markerMatchParent parent,
+            beforePseudo = Nothing,
+            afterPseudo  = Nothing,
+            markerPseudo = Nothing
         }
 
     shorthand _ key value


@@ 133,10 143,26 @@ instance PropertyParser p => PropertyParser (TextStyle p) where
     -- Ignoring invalid properties.
     longhand TextStyle { inner = p' } TextStyle { inner = self' } key value
         | Nothing <- longhand p' self' key $ removeCounters value = Nothing
+    longhand _ self "content" [Ident "normal"] =
+        Just self {
+            counterProps =
+                [(k, val) | (k, val) <- counterProps self, k /= "content"]
+          }
     longhand parent self key value
         | key == "content" || Function "counter" `elem` value || Function "counters" `elem` value =
             Just $ self { counterProps = insertList key value $ counterProps self }
-        | otherwise = (\v -> self {inner = v}) <$> longhand (inner parent ) (inner self) key value
+        | otherwise = (\v -> self {inner = v}) <$>
+            longhand (inner parent ) (inner self) key value
+
+    pseudoEl self "before" calc = self { beforePseudo = Just $ calc self Nothing }
+    pseudoEl self "after" calc  = self { afterPseudo  = Just $ calc self Nothing }
+    pseudoEl self "marker" calc = self { markerPseudo = Just $ calc self Nothing }
+    pseudoEl self sel calc = self {
+        inner = pseudoEl (inner self) sel calc'
+      } where
+        calc' parent (Just base) =
+            inner $ calc temp { inner = parent } $ Just temp { inner = base }
+        calc' parent Nothing = inner $ calc temp { inner = parent } Nothing
 
 insertList :: Eq a => a -> b -> [(a, b)] -> [(a, b)]
 insertList key value list | Nothing <- lookup key list = (key, value) : list


@@ 177,28 203,71 @@ resolve = resolveWithCounterStyles defaultCounterStore
 resolveWithCounterStyles :: PropertyParser p =>
     CounterStore' -> StyleTree (TextStyle p) -> StyleTree p
 resolveWithCounterStyles (CounterStore counters) =
-    resolve' . collapseWS . applyCounters counters
+    resolve' . collapseWS . applyCounters counters . insertPseudos 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
+---- Lists & pseudo-elements
 --------
 
--- 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.
+insertPseudos :: PropertyParser p =>
+    CounterStore -> StyleTree (TextStyle p) -> StyleTree (TextStyle p)
+insertPseudos s (StyleTree self@TextStyle { afterPseudo = Just child } childs) =
+    insertPseudos s $
+        StyleTree self { afterPseudo = Nothing } (childs ++ [t child])
+insertPseudos s (StyleTree self@TextStyle { beforePseudo = Just child } childs) =
+    insertPseudos s $ StyleTree self { beforePseudo = Nothing } (t child:childs)
+
+insertPseudos s (StyleTree self@TextStyle { markerPseudo = Nothing } childs) =
+    insertPseudos s $ StyleTree self { markerPseudo = Just temp } childs
+insertPseudos s self@(StyleTree TextStyle { markerPseudo = Just child} _)
+    | Just text <- lookup "content" $ counterProps child =
+        addBullet self s text
+insertPseudos s self@(StyleTree TextStyle { listStyleImage = bullet@(_:_) } _) =
+    addBullet self s (bullet ++ [String " "])
+insertPseudos s self@(StyleTree TextStyle { listStyleType = bullet@(_:_) } _)
+    | Just (cstyle, _) <- parseCounter s bullet = addBullet self s $ text cstyle
+  where
+    text counter = String (prefix counter):
+        Function "counter":Ident "list-item":Comma:bullet ++
+        [String $ suffix counter]
+
+insertPseudos store (StyleTree self childs) =
+    StyleTree self $ map (insertPseudos store) childs
+
+addBullet :: PropertyParser p =>
+    StyleTree (TextStyle p) -> CounterStore -> [Token] -> StyleTree (TextStyle p)
+addBullet (StyleTree self@TextStyle {
+        isListItem = True, listPosInside = True, markerPseudo = Just child
+    } childs) store txt = insertPseudos store $
+        StyleTree self { isListItem = False } (t child {
+            counterProps = insertList "content" txt $ counterProps child
+        } : childs)
+addBullet (StyleTree self@TextStyle {
+        isListItem = True, listPosInside = False, markerPseudo = Just child
+    } childs) store txt = insertPseudos store $
+        StyleTree self {
+            isListItem = False,
+            -- Flex lays out children horizontally at min size.
+            counterProps=insertList "display" [Ident "flex"] $ counterProps child
+        } [
+            t child {
+                counterProps= insertList "content" txt $ counterProps child
+            },
+            -- Generate a new layout box for the bullet to sit outside of.
+            StyleTree temp childs
+        ]
+addBullet (StyleTree self childs) store _ =
+    insertPseudos store $ StyleTree self {
+        isListItem = False,
+        listStyleImage = [], listStyleType = []
+    } childs
+
+t :: p -> StyleTree p
+t = flip StyleTree []
 
 --------
 ---- Counters