From cdfed3f971ed51bfbb4c592be971e72deeff90dd Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 2 May 2023 14:45:31 +1200 Subject: [PATCH] Preprocess away lists, add builtin ::before/::after support. --- src/Data/CSS/Preprocessor/Text.hs | 109 ++++++++++++++++++++++++------ 1 file changed, 89 insertions(+), 20 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Text.hs b/src/Data/CSS/Preprocessor/Text.hs index 193f6c8..5e4f007 100644 --- a/src/Data/CSS/Preprocessor/Text.hs +++ b/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 -- 2.30.2