~alcinnz/CatTrap

ref: ed7d0445f81669bd8fc7bec6f79a42ce1ca5108a CatTrap/Graphics/Layout/Grid/CSS.hs -rw-r--r-- 5.5 KiB
ed7d0445 — Adrian Cochrane Parse CSS4 Grid properties. 1 year, 8 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
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