~alcinnz/CatTrap

CatTrap/Graphics/Layout/Flex/CSS.hs -rw-r--r-- 9.0 KiB
8e7be851 — Adrian Cochrane Release 0.6! 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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
{-# LANGUAGE OverloadedStrings #-}
-- | Parse FlexBox-related CSS properties
module Graphics.Layout.Flex.CSS(CSSFlex(..), lowerFlex) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Stylist (PropertyParser(..), TrivialPropertyParser, parseOperands,
                parseUnorderedShorthand', parseUnorderedShorthand)
import Graphics.Layout.Flex as F
import Graphics.Layout.CSS.Length (parseLength, finalizeLength, n2f, Unitted, Font')
import Graphics.Layout.Box (Length)
import Data.Maybe (isJust)

-- | Parsed FlexBox-related CSS properties.
data CSSFlex = CSSFlex {
    -- | Parsed CSS flex-direction, axis component.
    directionCSS :: Direction,
    -- | Parsed CSS flex-direction, reversed flag
    reverseRowsCSS :: Bool,
    -- | Parsed CSS flex-wrap
    wrapCSS :: FlexWrapping,
    -- | Parsed CSS justify-content
    justifyCSS :: Maybe Justification,
    -- | Parsed CSS align-items
    alignItemsCSS :: Alignment,
    -- | Parsed CSS align-content, `Nothing` is "stretch"
    alignLinesCSS :: Maybe Justification,
    -- | Parsed CSS row-gap
    rowGapCSS :: Unitted,
    -- | Parsed CSS column-gap
    columnGapCSS :: Unitted,

    -- flex children
    -- | Parsed CSS order
    orderCSS :: Integer,
    -- | Parsed CSS flex-grow
    growCSS :: Double,
    -- | Parsed CSS flex-shrink
    shrinkCSS :: Double,
    -- | Parsed CSS flex-basis
    basisCSS :: Unitted,
    -- | Parsed CSS align-self
    alignSelfCSS :: Alignment,
    -- | Whether justification or alignment properties should be parsed as right-to-left or left-to-right.
    textRTL :: Bool -- Extra parameter from caller.
}

setDir self dir rev = Just self { directionCSS = dir, reverseRowsCSS = rev }

parseJustify self "flex-start" | reverseRowsCSS self = Just JEnd
    | otherwise = Just JStart
parseJustify self "flex-end" | reverseRowsCSS self = Just JStart
    | otherwise = Just JEnd
parseJustify self "start" | textRTL self = Just JEnd
    | otherwise = Just JStart
parseJustify self "end" | textRTL self = Just JStart
    | otherwise = Just JEnd
parseJustify _ "left" = Just JStart
parseJustify _ "right" = Just JEnd
parseJustify _ "center" = Just JCenter
parseJustify _ "space-between" = Just JSpaceBetween
parseJustify _ "space-around" = Just JSpaceAround
parseJustify _ "space-evenly" = Just JSpaceEvenly
parseJustify _ _ = Nothing

parseAlign _ "stretch" = Just AlStretch
parseAlign self "flex-start" | reverseRowsCSS self = Just AlEnd
    | otherwise = Just AlStart
parseAlign _ "start" = Just AlStart
parseAlign self "self-start" | textRTL self = Just AlEnd
    | otherwise = Just AlStart
parseAlign self "flex-end" | reverseRowsCSS self = Just AlStart
    | otherwise = Just AlEnd
parseAlign _ "end" = Just AlEnd
parseAlign self "self-end" | textRTL self = Just AlStart
    | otherwise = Just AlEnd
parseAlign _ "center" = Just AlCenter
parseAlign _ "baseline" = Just AlBaseline
parseAlign _ _ = Nothing

instance PropertyParser CSSFlex where
    temp = CSSFlex {
        directionCSS = Row,
        reverseRowsCSS = False,
        wrapCSS = NoWrap,
        justifyCSS = Nothing, -- flex-start, conditional on directionCSS
        alignItemsCSS = AlStretch,
        alignLinesCSS = Just JStart,
        rowGapCSS = (0,"px"),
        columnGapCSS = (0,"px"),
        orderCSS = 0,
        growCSS = 0,
        shrinkCSS = 1,
        basisCSS = (0,"auto"),
        alignSelfCSS = AlStretch, -- Should be auto, but we're implementing that in `inherit`.
        textRTL = False
      }
    inherit parent = temp { alignSelfCSS = alignItemsCSS parent }
    priority _ = ["flex-direction"]

    longhand _ self "flex-direction" [Ident "row"] = setDir self Row False
    longhand _ self "flex-direction" [Ident "row-reverse"] = setDir self Row True
    longhand _ self "flex-direction" [Ident "column"] = setDir self F.Column False
    longhand _ self "flex-direction" [Ident "column-reverse"] =
        setDir self F.Column True
    longhand _ self "flex-direction" [Ident "initial"] = setDir self Row False

    longhand _ self "flex-wrap" [Ident "no-wrap"] = Just self { wrapCSS = NoWrap }
    longhand _ self "flex-wrap" [Ident "wrap"] = Just self { wrapCSS = Wrap }
    longhand _ self "flex-wrap" [Ident "wrap-reverse"] =
        Just self { wrapCSS = WrapReverse }
    longhand _ self "flex-wrap" [Ident "initial"] = Just self { wrapCSS = NoWrap }

    longhand _ self "justify-content" [Ident x]
        | x == "initial" = Just self { justifyCSS = parseJustify self "flex-start" }
        | y@(Just _) <- parseJustify self x = Just self { justifyCSS = y }

    longhand _ self "align-items" [Ident x]
        | x == "initial" = Just self { alignItemsCSS = AlStretch }
        | Just y <- parseAlign self x = Just self { alignItemsCSS = y }

    longhand _ self "align-content" [Ident x] | x `elem` ["initial", "normal"] =
            Just self { alignLinesCSS = parseJustify self "start" }
        | x == "stretch" = Just self { alignLinesCSS = Nothing }
        | y@(Just _) <- parseJustify self x = Just self { alignLinesCSS = y }

    longhand _ self "row-gap" [Ident x]
        | x `elem` ["initial", "normal"] = Just self { rowGapCSS = (0,"px") }
        | otherwise = Nothing
    longhand _ self "row-gap" toks
        | Just x <- parseLength toks = Just self { rowGapCSS = x}
    longhand _ self "column-gap" [Ident x]
        | x `elem` ["initial", "normal"] = Just self { columnGapCSS = (0,"px") }
        | otherwise = Nothing
    longhand _ self "column-gap" toks
        | Just x <- parseLength toks = Just self { columnGapCSS = x }

    longhand _ self "order" [Number _ (NVInteger x)] = Just self { orderCSS = x }
    longhand _ self "order" [Ident "initial"] = Just self { orderCSS = 0 }

    longhand _ self "flex-grow" [Number _ x] | n2f x>0 = Just self {growCSS=n2f x}
    longhand _ self "flex-grow" [Ident "initial"] = Just self { growCSS = 0 }
    longhand _ self "flex-shrink" [Number _ x] | n2f x > 0 =
        Just self { shrinkCSS = n2f x }
    longhand _ self "flex-shrink" [Ident "initial"] = Just self { shrinkCSS = 1 }

    longhand _ self "flex-basis" toks | Just x <- parseLength toks =
        Just self { basisCSS = x }

    longhand parent self "align-self" [Ident x] | x `elem` ["initial", "auto"] =
            Just self { alignSelfCSS = alignItemsCSS parent }
        | Just y <- parseAlign self x = Just self { alignSelfCSS = y }

    longhand _ _ _ _ = Nothing

    shorthand self "flex-flow" toks =
        parseUnorderedShorthand self ["flex-direction", "flex-wrap"] toks
    shorthand self "gap" toks | [x] <- parseOperands toks =
            parseUnorderedShorthand' self ["row-gap", "column-gap"] [x, x]
        | otherwise = parseUnorderedShorthand self ["row-gap", "column-gap"] toks
    shorthand self "flex" toks
        | [Ident "initial"] <- toks =
            [("flex-grow", init), ("flex-shrink", init), ("flex-basis", px0)]
        | [Ident "auto"] <- toks =
            [("flex-grow", n1), ("flex-shrink", n1), ("flex-basis", init)]
        | [Ident "none"] <- toks =
            [("flex-grow", n0), ("flex-shrink", n0), ("flex-basis", init)]
        | [a] <- operands, test "flex-grow" a =
            [("flex-grow", a), ("flex-shrink", init), ("flex-basis", px0)]
        | [a] <- operands, test "flex-basis" a =
            [("flex-grow", n1), ("flex-shrink", init), ("flex-basis", a)]
        | [a, b] <- operands, test "flex-grow" a, test "flex-shrink" b =
            [("flex-grow", a), ("flex-shrink", b), ("flex-basis", px0)]
        | [a, b] <- operands, test "flex-grow" a, test "flex-basis" b =
            [("flex-grow", a), ("flex-shrink", init), ("flex-basis", b)]
        | [a, b, c] <- operands, test "flex-grow" a, test "flex-shrink" b, test "flex-basis" c =
            [("flex-grow", a), ("flex-shrink", b), ("flex-basis", c)]
      where
        operands = parseOperands toks
        test a = isJust . longhand self self a
        init = [Ident "initial"]
        px0 = [Dimension "0" (NVInteger 0) "px"]
        n1 = [Number "1" (NVInteger 1)]
        n0 = [Number "0" (NVInteger 0)]
    shorthand self k v | Just _ <- longhand self self k v = [(k, v)]
        | otherwise = []

-- | Lower the Flexbox styling tree to the Layout tree.
lowerFlex :: CSSFlex -> Font' -> [CSSFlex] -> [a] -> [Font'] -> Flex a Length
lowerFlex self font kids kids' fonts' = Flex {
    direction = directionCSS self,
    reverseRows = reverseRowsCSS self,
    wrap = wrapCSS self,
    justify = case justifyCSS self of
        Just x -> x
        Nothing | reverseRowsCSS self -> JEnd
        Nothing -> JStart,
    alignLines = alignLinesCSS self,
    baseGap = case directionCSS self of
        Row -> flip finalizeLength font $ rowGapCSS self
        F.Column -> flip finalizeLength font $ columnGapCSS self,
    crossGap = case directionCSS self of
        Row -> flip finalizeLength font $ columnGapCSS self
        F.Column -> flip finalizeLength font $ rowGapCSS self,
    pageWidth = 0,
    children = [[FlexChild {
        grow = growCSS kid,
        shrink = shrinkCSS kid,
        basis = flip finalizeLength font' $ rowGapCSS kid,
        alignment = alignSelfCSS kid,
        flexInner = kid'
      } | (kid, kid', font') <- zip3 kids kids' fonts']]
  }