~alcinnz/CatTrap

ref: 7beb48286350645043875941093f076bca84e81b CatTrap/Graphics/Layout/CSS.hs -rw-r--r-- 6.2 KiB
7beb4828 — Adrian Cochrane Draft grid preprocessor which sucessfully compiles. 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
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.CSS where

import Data.CSS.Syntax.Tokens (Token(..))
import qualified Data.Text as Txt
import Stylist (PropertyParser(..), TrivialPropertyParser)

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,
    gridStyles :: CSSGrid,
    cellStyles :: CSSCell
}
data BoxSizing = BorderBox | ContentBox
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,
            B.max = Size auto auto,
            padding = noborder,
            border = noborder,
            margin = noborder
        },
        font = 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,
        gridStyles = inherit $ gridStyles parent,
        cellStyles = inherit $ cellStyles parent
      }

    longhand _ self "box-sizing" [Ident "content-box"] = Just self {boxSizing = ContentBox}
    longhand _ self "box-sizing" [Ident "border-box"] = Just self {boxSizing = BorderBox}
    longhand _ self "box-sizing" [Ident "initial"] = Just self {boxSizing = ContentBox}

    longhand _ self@CSSBox {cssBox = box} "padding-top" toks | Just x <- parseLength toks =
        Just self { cssBox = box { padding = (padding box) { top = x } } }
    longhand _ self@CSSBox {cssBox = box} "padding-bottom" toks | Just x <- parseLength toks =
        Just self { cssBox = box { padding = (padding box) { bottom = x } } }
    longhand _ self@CSSBox {cssBox = box} "padding-left" toks | Just x <- parseLength toks =
        Just self { cssBox = box { padding = (padding box) { left = x } } }
    longhand _ self@CSSBox {cssBox = box} "padding-right" toks | Just x <- parseLength toks =
        Just self { cssBox = box { padding = (padding box) { right = x } } }
    longhand _ self@CSSBox {cssBox = box} "border-top-width" toks | Just x <- parseLength toks =
        Just self { cssBox = box { border = (border box) { top = x } } }
    longhand _ self@CSSBox {cssBox = box} "border-bottom-width" toks | Just x <- parseLength toks =
        Just self { cssBox = box { border = (border box) { bottom = x } } }
    longhand _ self@CSSBox {cssBox = box} "border-left-width" toks | Just x <- parseLength toks =
        Just self { cssBox = box { border = (border box) { left = x } } }
    longhand _ self@CSSBox {cssBox = box} "border-right-width" toks | Just x <- parseLength toks =
        Just self { cssBox = box { border = (border box) { right = x } } }
    longhand _ self@CSSBox {cssBox = box} "margin-top" toks | Just x <- parseLength toks =
        Just self { cssBox = box { margin = (margin box) { top = x } } }
    longhand _ self@CSSBox {cssBox = box} "margin-bottom" toks | Just x <- parseLength toks =
        Just self { cssBox = box { margin = (margin box) { bottom = x } } }
    longhand _ self@CSSBox {cssBox = box} "margin-left" toks | Just x <- parseLength toks =
        Just self { cssBox = box { margin = (margin box) { left = x } } }
    longhand _ self@CSSBox {cssBox = box} "margin-right" toks | Just x <- parseLength toks =
        Just self { cssBox = box { margin = (margin box) { right = x } } }

    longhand _ self@CSSBox {cssBox = box} "width" toks | Just x <- parseLength' toks =
        Just self { cssBox = box { size = (size box) { inline = x } } }
    longhand _ self@CSSBox {cssBox = box} "height" toks | Just x <- parseLength' toks =
        Just self { cssBox = box { size = (size box) { block = x } } }
    longhand _ self@CSSBox {cssBox = box} "max-width" toks | Just x <- parseLength' toks =
        Just self { cssBox = box { B.max = (B.max box) { inline = x } } }
    longhand _ self@CSSBox {cssBox = box} "min-width" toks | Just x <- parseLength' toks =
        Just self { cssBox = box { B.min = (B.min box) { inline = x } } }
    longhand _ self@CSSBox {cssBox = box} "max-height" toks | Just x <- parseLength' toks =
        Just self { cssBox = box { B.max = (B.max box) { block = x } } }
    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'
      }
    longhand a b c d | Just inner' <- longhand (inner a) (inner b) c d = Just b {
        inner = inner'
      }
    longhand _ _ _ _ = Nothing

{-finalizeCSS :: CSSBox -> LayoutItem Length-}