From 5dc32d0612f7ca61c8cc7ddb4f890b2e62cf1376 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 28 Apr 2023 15:58:07 +1200 Subject: [PATCH] Parse list-style longhand properties, tweak counter-lookup. --- src/Data/CSS/Preprocessor/Text.hs | 66 +++++++++++++++++-- .../CSS/Preprocessor/Text/CounterStyle.hs | 8 +-- 2 files changed, 65 insertions(+), 9 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Text.hs b/src/Data/CSS/Preprocessor/Text.hs index cb0ec26..9148698 100644 --- a/src/Data/CSS/Preprocessor/Text.hs +++ b/src/Data/CSS/Preprocessor/Text.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 } diff --git a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs index 95e2085..0fd35f3 100644 --- a/src/Data/CSS/Preprocessor/Text/CounterStyle.hs +++ b/src/Data/CSS/Preprocessor/Text/CounterStyle.hs @@ -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 -- 2.30.2