aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/format/html.lux
blob: ef2e0abf07cad4730c446a5cdcdf34e6c3a8521a (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
(.module:
  [lux #- comment]
  (lux (data [text]
             text/format
             (coll [list "L/" Functor<List>]))))

(type: #export Attributes
  {#.doc "Attributes for an HTML tag."}
  (List [Text Text]))

(type: #export HTML Text)

(def: #export (text value)
  {#.doc "Properly formats text to ensure no injection can happen on the HTML."}
  (-> Text HTML)
  (|> value
      (text.replace-all "&" "&amp;")
      (text.replace-all "<" "&lt;")
      (text.replace-all ">" "&gt;")
      (text.replace-all "\"" "&quot;")
      (text.replace-all "'" "&#x27;")
      (text.replace-all "/" "&#x2F;")))

(def: #export (comment content)
  (-> Text HTML)
  (format "<!--" (text content) "-->"))

(def: attrs-to-text
  (-> Attributes Text)
  (|>> (L/map (function (_ [key val]) (format key "=" "\"" (text val) "\"")))
       (text.join-with " ")))

(def: #export (tag name attrs children)
  {#.doc "Generates the HTML for a tag."}
  (-> Text Attributes (List HTML) HTML)
  (format "<" name " " (attrs-to-text attrs) ">"
          (text.join-with " " children)
          "</" name ">"))

(do-template [<name> <doc-type>]
  [(def: #export (<name> document)
     (-> HTML HTML)
     (format <doc-type>
             document))]

  [html-5    "<!DOCTYPE html>"]
  [html-4_01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"]
  [xhtml-1_0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"]
  [xhtml-1_1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"]
  )