M Graphics/Layout/CSS.hs => Graphics/Layout/CSS.hs +35 -25
@@ 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-}
A Graphics/Layout/CSS/Internal.hs => Graphics/Layout/CSS/Internal.hs +27 -0
@@ 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
A Graphics/Layout/Grid/CSS.hs => Graphics/Layout/Grid/CSS.hs +139 -0
@@ 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
M cattrap.cabal => cattrap.cabal +2 -1
@@ 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