aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/format/css.lux
blob: 78165b4af2650579282a5fd2417bef26a57f92d6 (plain)
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
(.module:
  [lux (#- and)
   [data
    ["." maybe]
    ["." number]
    ["." text
     format
     ["." encoding (#+ Encoding)]]
    [collection
     [list ("list/." Functor<List>)]]]
   [type
    abstract]
   [world
    [net (#+ URL)]]]
  [/
   ["/." selector (#+ Selector Combinator)]
   ["/." value (#+ Value)]
   ["/." font (#+ Font)]
   ["/." style (#+ Style)]])

(abstract: #export CSS
  {}

  Text

  (def: #export empty CSS (:abstraction ""))

  (def: #export (rule selector style)
    (-> (Selector Any) Style CSS)
    (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}")))

  (def: #export char-set
    (-> Encoding CSS)
    (|>> encoding.name
         %t
         (text.enclose ["@charset " ";"])
         :abstraction))

  (def: #export (font font)
    (-> Font CSS)
    (let [with-unicode (case (get@ #/font.unicode-range font)
                         (#.Some unicode-range)
                         (let [unicode-range' (format "U+" (:: number.Hex@Codec<Text,Nat> encode (get@ #/font.start unicode-range))
                                                      "-" (:: number.Hex@Codec<Text,Nat> encode (get@ #/font.end unicode-range)))]
                           (list ["unicode-range" unicode-range']))
                         
                         #.None
                         (list))]
      (|> (list& ["font-family" (get@ #/font.family font)]
                 ["src" (format "url(" (get@ #/font.source font) ")")]
                 ["font-stretch" (|> font (get@ #/font.stretch) (maybe.default /value.normal-stretch) /value.value)]
                 ["font-style" (|> font (get@ #/font.style) (maybe.default /value.normal-style) /value.value)]
                 ["font-weight" (|> font (get@ #/font.weight) (maybe.default /value.normal-weight) /value.value)]
                 with-unicode)
          (list/map (function (_ [property value])
                      (format property ": " value ";")))
          (text.join-with /style.separator)
          (text.enclose ["{" "}"])
          (format "@font-face")
          :abstraction)))

  (def: #export (import url)
    (-> URL CSS)
    (:abstraction (format (format "@import url(" (%t url) ")")
                          ";")))

  (def: css-separator text.new-line)

  (def: #export (and pre post)
    (-> CSS CSS CSS)
    (:abstraction (format (:representation pre) ..css-separator
                          (:representation post))))

  (def: #export (alter combinator selector css)
    (-> Combinator (Selector Any) CSS CSS)
    (|> css
        :representation
        (text.split-all-with ..css-separator)
        (list/map (|>> (format (/selector.selector (combinator selector (/selector.tag ""))))))
        (text.join-with ..css-separator)
        :abstraction))

  (def: #export (dependent combinator selector style inner)
    (-> Combinator (Selector Any) Style CSS CSS)
    (..and (..rule selector style)
           (..alter combinator selector inner)))

  (do-template [<name> <combinator>]
    [(def: #export <name>
       (-> (Selector Any) Style CSS CSS)
       (..dependent <combinator>))]

    [with-descendants /selector.in]
    [with-children /selector.sub]
    )
  )