From ed7d0445f81669bd8fc7bec6f79a42ce1ca5108a Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Sun, 5 Mar 2023 16:25:03 +1300 Subject: [PATCH] Parse CSS4 Grid properties. --- Graphics/Layout/CSS.hs | 60 ++++++++------ Graphics/Layout/CSS/Internal.hs | 27 +++++++ Graphics/Layout/Grid/CSS.hs | 139 ++++++++++++++++++++++++++++++++ cattrap.cabal | 3 +- 4 files changed, 203 insertions(+), 26 deletions(-) create mode 100644 Graphics/Layout/CSS/Internal.hs create mode 100644 Graphics/Layout/Grid/CSS.hs diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index fe390be..d63e36d 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -1,29 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} module Graphics.Layout.CSS where -import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) +import Data.CSS.Syntax.Tokens (Token(..)) import qualified Data.Text as Txt import Stylist (PropertyParser(..), TrivialPropertyParser) -import Data.Scientific (toRealFloat) import Graphics.Layout.Box as B import Graphics.Layout import Graphics.Text.Font.Choose (Pattern(..)) +import Graphics.Layout.CSS.Internal +import Graphics.Layout.Grid.CSS data CSSBox a = CSSBox { + display :: Display, boxSizing :: BoxSizing, cssBox :: PaddedBox Unitted Unitted, -- Some units need to be resolved per font. calc()? font :: Pattern, - inner :: a + inner :: a, + gridStyles :: CSSGrid, + cellStyles :: CSSCell } data BoxSizing = BorderBox | ContentBox -type Unitted = (Double, Txt.Text) -auto = (0,"auto") noborder = Border (0,"px") (0,"px") (0,"px") (0,"px") +data Display = Block | Grid | Table | + TableRow | TableHeaderGroup | TableRowGroup | TableFooterGroup | TableCell | + TableColumn | TableColumnGroup | TableCaption + instance PropertyParser a => PropertyParser (CSSBox a) where temp = CSSBox { boxSizing = ContentBox, + display = Block, cssBox = PaddedBox { B.min = Size auto auto, size = Size auto auto, @@ -33,13 +40,18 @@ instance PropertyParser a => PropertyParser (CSSBox a) where margin = noborder }, font = temp, - inner = temp + inner = temp, + gridStyles = temp, + cellStyles = temp } inherit parent = CSSBox { boxSizing = boxSizing parent, + display = Block, cssBox = cssBox (temp :: CSSBox TrivialPropertyParser), font = inherit $ font parent, - inner = inherit $ inner parent + inner = inherit $ inner parent, + gridStyles = inherit $ gridStyles parent, + cellStyles = inherit $ cellStyles parent } longhand _ self "box-sizing" [Ident "content-box"] = Just self {boxSizing = ContentBox} @@ -84,6 +96,22 @@ instance PropertyParser a => PropertyParser (CSSBox a) where longhand _ self@CSSBox {cssBox = box} "min-height" toks | Just x <- parseLength' toks = Just self { cssBox = box { B.min = (B.min box) { block = x } } } + longhand _ self "display" [Ident "block"] = Just self { display = Block } + longhand _ self "display" [Ident "grid"] = Just self { display = Grid } + longhand _ self "display" [Ident "table"] = Just self { display = Table } + longhand _ self "display" [Ident "table-row-group"] = Just self {display=TableRowGroup} + longhand _ self "display" [Ident "table-header-group"] = + Just self { display = TableHeaderGroup } + longhand _ self "display" [Ident "table-footer-group"] = + Just self { display = TableFooterGroup } + longhand _ self "display" [Ident "table-row"] = Just self {display = TableRow} + longhand _ self "display" [Ident "table-cell"] = Just self {display = TableCell} + longhand _ self "display" [Ident "table-column-group"] = + Just self { display = TableColumnGroup } + longhand _ self "display" [Ident "table-column"] = Just self {display = TableColumn} + longhand _ self "display" [Ident "table-caption"] = Just self {display=TableCaption} + longhand _ self "display" [Ident "initial"] = Just self {display = Block } + longhand a b c d | Just font' <- longhand (font a) (font b) c d = Just b { font = font' } @@ -92,22 +120,4 @@ instance PropertyParser a => PropertyParser (CSSBox a) where } longhand _ _ _ _ = Nothing -parseLength :: [Token] -> Maybe Unitted -parseLength [Percentage _ x] = Just (n2f x,"%") -parseLength [Dimension _ x unit] - | n2f x == 0 && unit == "" = Just (0,"px") - | unit `elem` units = Just (n2f x,unit) -parseLength [Ident "auto"] = Just (0,"auto") -parseLength [Ident "initial"] = Just (0,"px") -parseLength _ = Nothing -parseLength' [Ident "min-content"] = Just (0,"min-content") -parseLength' [Ident "max-content"] = Just (0,"max-content") -parseLength' [Ident "auto"] = Just (0,"auto") -parseLength' toks = parseLength toks - -units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin vb vi px cm mm Q in pc pt %" - -n2f (NVInteger x) = realToFrac x -n2f (NVNumber x) = toRealFloat x - {-finalizeCSS :: CSSBox -> LayoutItem Length-} diff --git a/Graphics/Layout/CSS/Internal.hs b/Graphics/Layout/CSS/Internal.hs new file mode 100644 index 0000000..c545e5b --- /dev/null +++ b/Graphics/Layout/CSS/Internal.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} +module Graphics.Layout.CSS.Internal where + +import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) +import qualified Data.Text as Txt +import Data.Scientific (toRealFloat) + +type Unitted = (Double, Txt.Text) +auto :: Unitted +auto = (0,"auto") + +parseLength :: [Token] -> Maybe Unitted +parseLength [Percentage _ x] = Just (n2f x,"%") +parseLength [Dimension _ x unit] + | n2f x == 0 && unit == "" = Just (0,"px") + | unit `elem` units = Just (n2f x,unit) +parseLength [Ident "auto"] = Just (0,"auto") +parseLength [Ident "initial"] = Just (0,"auto") +parseLength _ = Nothing +parseLength' [Ident "min-content"] = Just (0,"min-content") +parseLength' [Ident "max-content"] = Just (0,"max-content") +parseLength' toks = parseLength toks + +units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin vb vi px cm mm Q in pc pt %" + +n2f (NVInteger x) = realToFrac x +n2f (NVNumber x) = toRealFloat x diff --git a/Graphics/Layout/Grid/CSS.hs b/Graphics/Layout/Grid/CSS.hs new file mode 100644 index 0000000..8d3bb55 --- /dev/null +++ b/Graphics/Layout/Grid/CSS.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} +module Graphics.Layout.Grid.CSS where + +import Graphics.Layout.CSS.Internal +import Stylist (PropertyParser(..)) +import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) +import Data.Text (Text) +import qualified Data.Text as Txt +import Data.Char (isAlphaNum) + +data CSSGrid = CSSGrid { + autoColumns :: Unitted, + autoFlow :: Axis, + autoFlowDense :: Bool, + autoRows :: Unitted, + templateAreas :: [[Text]], + templateColumns :: Either [([Text], Unitted)] [Text], + templateRows :: Either [([Text], Unitted)] [Text] +} +data Axis = Row | Col +data CSSCell = CSSCell { + columnStart :: Placement, + columnEnd :: Placement, + rowStart :: Placement, + rowEnd :: Placement +} +data Placement = Autoplace | Named Text | Numbered Int (Maybe Text) | + Span Int (Maybe Text) + +instance PropertyParser CSSGrid where + temp = CSSGrid { + autoColumns = auto, + autoFlow = Row, + autoFlowDense = False, + autoRows = auto, + templateAreas = [], + templateColumns = Left [], + templateRows = Left [] + } + inherit _ = temp + + longhand _ s "grid-auto-columns" toks | Just x <- parseFR toks = Just s {autoColumns=x} + longhand _ s "grid-auto-rows" toks | Just x <- parseFR toks = Just s {autoColumns = x} + + longhand _ self "grid-auto-flow" [Ident "row"] = Just self { + autoFlow = Row, autoFlowDense = False + } + longhand _ self "grid-auto-flow" [Ident "column"] = Just self { + autoFlow = Col, autoFlowDense = False + } + longhand _ self "grid-auto-flow" [Ident "row", Ident "dense"] = Just self { + autoFlow = Row, autoFlowDense = True + } + longhand _ self "grid-auto-flow" [Ident "column", Ident "dense"] = Just self { + autoFlow = Col, autoFlowDense = True + } + + longhand _ self "grid-template-areas" [Ident "none"] = Just self {templateAreas = []} + longhand _ self "grid-template-areas" [Ident "initial"] = Just self {templateAreas=[]} + longhand _ self "grid-template-areas" toks + | all isString toks, validate [Txt.words x | String x <- toks] = + Just self { templateAreas = [Txt.words x | String x <- toks] } + where + isString (String _) = True + isString _ = False + validate grid@(row:rows) = + all isValidName (concat grid) && all (\x -> length row == length x) rows + validate [] = False + isValidName name = Txt.all (\c -> isAlphaNum c || c == '-') name + + longhand _ self "grid-template-columns" toks | Just x <- parseTemplate toks = + Just self { templateColumns = x } + longhand _ self "grid-template-rows" toks | Just x <- parseTemplate toks = + Just self { templateRows = x} + longhand _ _ _ _ = Nothing + +instance PropertyParser CSSCell where + temp = CSSCell { + columnStart = Autoplace, + columnEnd = Autoplace, + rowStart = Autoplace, + rowEnd = Autoplace + } + inherit _ = temp + + longhand _ self "grid-column-start" toks | Just x <- placement toks = + Just self { columnStart = x} + longhand _ s "grid-column-end" toks | Just x <- placement toks = Just s {columnEnd=x} + longhand _ s "grid-row-start" toks | Just x <- placement toks = Just s {rowStart = x} + longhand _ s "grid-row-end" toks | Just x <- placement toks = Just s { rowEnd = x } + longhand _ _ _ _ = Nothing + +{-finalizeGrid :: CSSBox -> LayoutItem Length-} + +parseFR [Dimension _ x "fr"] = Just (n2f x,"fr") +parseFR toks = parseLength toks +parseFR' [Dimension _ x "fr"] = Just (n2f x,"fr") +parseFR' toks = parseLength' toks + +placement [Ident "auto"] = Just $ Autoplace +placement [Ident x] = Just $ Named x +placement [Number _ (NVInteger x)] = Just $ Numbered (fromEnum x) Nothing +placement [Number _ (NVInteger x), Ident y] = Just $ Numbered (fromEnum x) (Just y) +placement [Ident "span", Number _ (NVInteger x)] + | x > 0 = Just $ Span (fromEnum x) Nothing +placement [Ident "span", Ident x] = Just $ Span 1 $ Just x +placement [Ident "span", Number _ (NVInteger x), Ident y] + | x > 0 = Just $ Span (fromEnum x) (Just y) +placement [Ident "span", Ident y, Number _ (NVInteger x)] + | x > 0 = Just $ Span (fromEnum x) (Just y) +placement _ = Nothing + +parseTemplate [Ident "none"] = Just $ Left [] +parseTemplate [Ident "initial"] = Just $ Left [] +parseTemplate toks | (tracks@(_:_), []) <- parseTrack toks = Just $ Left tracks +parseTemplate (Ident "subgrid":toks) + | (names@(_:_), []) <- parseSubgrid toks = Just $ Right names +parseTemplate _ = Nothing +parseTrack (LeftSquareBracket:toks) + | Just (names', toks') <- parseNames toks, + ((names,size):cells,toks) <- parseTrack toks' = ((names' ++ names,size):cells,toks) + | Just (names', toks') <- parseNames toks = ([(names',(0,"end"))],toks') +parseTrack (tok:toks) | Just x <- parseFR' [tok] = + (([], x):fst (parseTrack toks), snd $ parseTrack toks) +parseTrack (Function "repeat":Number _ (NVInteger x):Comma:toks) + | x > 0, (tracks@(_:_), RightParen:toks') <- parseTrack toks = + (concat $ replicate (fromEnum x) tracks, toks') +parseTrack toks = ([], toks) +parseSubgrid (LeftSquareBracket:toks) + | Just (names', toks') <- parseNames toks, (names,toks'') <- parseSubgrid toks' = + (names' ++ names, toks') +parseSubgrid (Function "repeat":Number _ (NVInteger x):Comma:toks) + | x > 0, (names@(_:_), RightParen:toks') <- parseSubgrid toks = + (concat $ replicate (fromEnum x) names, toks') +parseSubgrid toks = ([], toks) +parseNames (Ident x:toks) + | Just (names,toks') <- parseNames toks = Just (x:names,toks') +parseNames (RightSquareBracket:toks) = Just ([], toks) +parseNames _ = Nothing diff --git a/cattrap.cabal b/cattrap.cabal index a30f842..704e6a8 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -18,7 +18,8 @@ cabal-version: >=1.10 library exposed-modules: Graphics.Layout, Graphics.Layout.CSS, Graphics.Layout.Flow, - Graphics.Layout.Grid, Graphics.Layout.Box, Graphics.Layout.Arithmetic + Graphics.Layout.Grid, Graphics.Layout.Box, Graphics.Layout.Arithmetic, + Graphics.Layout.CSS.Internal, Graphics.Layout.Grid.CSS -- other-modules: -- other-extensions: build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits, fontconfig-pure -- 2.30.2