aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/format/html.lux432
1 files changed, 347 insertions, 85 deletions
diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux
index b260a8768..7eb26bf5a 100644
--- a/stdlib/source/lux/data/format/html.lux
+++ b/stdlib/source/lux/data/format/html.lux
@@ -1,17 +1,20 @@
(.module:
- [lux (#- Meta comment and)
+ [lux (#- Meta Source comment and)
[data
+ ["." product]
["." maybe]
["." text
format]
[collection
- [list ("list/." Functor<List>)]]]
+ [list ("list/." Functor<List> Fold<List>)]]]
+ ["." function]
[type
abstract]
[world
[net (#+ URL)]]]
[//
- ["." css (#+ CSS)]])
+ ["." css (#+ CSS)]
+ ["." xml (#+ XML)]])
(type: #export Tag Text)
@@ -66,20 +69,25 @@
(-> Tag Text)
(text.enclose ["</" ">"]))
-(abstract: #export (HTML kind)
+(abstract: #export (HTML brand)
{}
Text
- (do-template [<name> <kind>]
- [(abstract: #export <kind> {} Any)
- (type: #export <name> (HTML <kind>))]
+ (do-template [<name> <brand>]
+ [(abstract: #export <brand> {} Any)
+ (type: #export <name> (HTML <brand>))]
[Meta Meta']
[Head Head']
[Item Item']
[Option Option']
[Input Input']
+ [Cell Cell']
+ [Header Header']
+ [Row Row']
+ [Column Column']
+ [Parameter Parameter']
[Body Body']
[Document Document']
)
@@ -89,13 +97,25 @@
(abstract: #export Content' {} Any)
(type: #export Content (HTML (Element' Content')))
+
+ (abstract: #export Image' {} Any)
+ (type: #export Image (HTML (Element' Image')))
+
+ (abstract: #export (Media' brand) {} Any)
+ (type: #export Media (HTML (Media' Any)))
+
+ (abstract: #export Source' {} Any)
+ (type: #export Source (HTML (Media' Source')))
+
+ (abstract: #export Track' {} Any)
+ (type: #export Track (HTML (Media' Track')))
(def: #export html
- (-> (HTML Any) Text)
+ (-> Document Text)
(|>> :representation))
(def: #export (and pre post)
- (All [kind] (-> (HTML kind) (HTML kind) (HTML kind)))
+ (All [brand] (-> (HTML brand) (HTML brand) (HTML brand)))
(:abstraction (format (:representation pre) (:representation post))))
(def: #export (comment content node)
@@ -104,22 +124,43 @@
(format (text.enclose ["<!--" "-->"] content)
(:representation node))))
- (def: (tag name)
- (-> Tag (-> Attributes (HTML Any) HTML))
- (function (_ attributes content)
- (:abstraction
- (format (..open name attributes)
- (:representation content)
- (..close name)))))
+ (def: (empty name attributes)
+ (-> Tag Attributes HTML)
+ (:abstraction
+ (format (..open name attributes)
+ (..close name))))
- (do-template [<name> <tag>]
- [(def: #export <name>
- (-> Attributes Meta)
- (|>> (..open <tag>)
- :abstraction))]
+ (def: (simple tag attributes)
+ (-> Tag Attributes HTML)
+ (|> attributes
+ (..open tag)
+ :abstraction))
+
+ (def: (tag name attributes content)
+ (-> Tag Attributes (HTML Any) HTML)
+ (:abstraction
+ (format (..open name attributes)
+ (:representation content)
+ (..close name))))
+
+ (def: (raw tag attributes content)
+ (-> Text Attributes Text HTML)
+ (:abstraction
+ (format (..open tag attributes)
+ content
+ (..close tag))))
- [link "link"]
- [meta "meta"]
+ (do-template [<name> <tag> <brand>]
+ [(def: #export <name>
+ (-> Attributes <brand>)
+ (..simple <tag>))]
+
+ [link "link" Meta]
+ [meta "meta" Meta]
+ [input "input" Input]
+ [embedded "embed" Element]
+ [column "col" Column]
+ [parameter "param" Parameter]
)
(def: #export (base href target)
@@ -131,33 +172,17 @@
#.None
partial)]
- (:abstraction (..open "base" full))))
-
- (do-template [<name> <tag>]
- [(def: #export (<name> content)
- (-> Text Meta)
- (:abstraction
- (format (..open <tag> (list))
- content
- (..close <tag>))))]
-
- [title "title"]
- [no-script "noscript"]
- )
+ (..simple "base" full)))
- (def: #export (style css)
+ (def: #export style
(-> CSS Meta)
- (:abstraction
- (format (..open "style" (list))
- css
- (..close "style"))))
+ (..raw "style" (list)))
(def: #export (script attributes inline)
(-> Attributes (Maybe Script) Meta)
- (:abstraction
- (format (..open "script" attributes)
- (maybe.default "" inline)
- (..close "script"))))
+ (|> inline
+ (maybe.default "")
+ (..raw "script" attributes)))
(def: #export text
(-> Text Content)
@@ -167,90 +192,270 @@
(do-template [<tag> <alias> <name>]
[(def: #export <name>
Element
- (:abstraction (..open <tag> (list))))
+ (..simple <tag> (list)))
(def: #export <alias> <name>)]
- ["br" br break]
- ["hr" hr separator]
+ ["br" br line-break]
+ ["wbr" wbr word-break]
+ ["hr" hr separator]
)
(def: #export (image source attributes)
- (-> URL Attributes Element)
+ (-> URL Attributes Image)
(|> attributes
(#.Cons ["src" source])
- (..open "img")
- :abstraction))
+ (..simple "img")))
+
+ (def: #export (svg attributes content)
+ (-> Attributes XML Element)
+ (|> content
+ (:: xml.Codec<Text,XML> encode)
+ (..raw "svg" attributes)))
+
+ (type: #export Coord
+ {#horizontal Nat
+ #vertical Nat})
+
+ (def: metric-separator ",")
+ (def: coord-separator ",")
+
+ (def: (%coord [horizontal vertical])
+ (Format Coord)
+ (format (%n horizontal) ..metric-separator (%n vertical)))
+
+ (type: #export Rectangle
+ {#start Coord
+ #end Coord})
+
+ (type: #export Circle
+ {#center Coord
+ #radius Nat})
+
+ (type: #export Polygon
+ {#first Coord
+ #second Coord
+ #third Coord
+ #extra (List Coord)})
+
+ (def: (%rectangle [start end])
+ (Format Rectangle)
+ (format (%coord start) ..coord-separator (%coord end)))
+
+ (def: (%circle [center radius])
+ (Format Circle)
+ (format (%coord center) ..metric-separator (%n radius)))
+
+ (def: (%polygon [first second third extra])
+ (Format Polygon)
+ (|> (list& first second third extra)
+ (list/map %coord)
+ (text.join-with ..coord-separator)))
+
+ (type: #export Shape
+ (#Rectangle Rectangle)
+ (#Circle Circle)
+ (#Polygon Polygon))
+
+ (do-template [<name> <shape> <type> <format>]
+ [(def: (<name> attributes shape)
+ (-> Attributes <type> (HTML Any))
+ (..simple "area" (list& ["shape" <shape>]
+ ["coords" (<format> shape)]
+ attributes)))]
+
+ [rectangle "rect" Rectangle ..%rectangle]
+ [circle "circle" Circle ..%circle]
+ [polygon "poly" Polygon ..%polygon]
+ )
+
+ (def: (area attributes shape)
+ (-> Attributes Shape (HTML Any))
+ (case shape
+ (#Rectangle rectangle)
+ (..rectangle attributes rectangle)
+
+ (#Circle circle)
+ (..circle attributes circle)
+
+ (#Polygon polygon)
+ (..polygon attributes polygon)))
+
+ (def: #export (map attributes areas for)
+ (-> Attributes (List [Attributes Shape]) Image Image)
+ ($_ ..and
+ for
+ (case (list/map (product.uncurry ..area) areas)
+ #.Nil
+ (..empty "map" attributes)
+
+ (#.Cons head tail)
+ (..tag "map" attributes
+ (list/fold (function.flip ..and) head tail)))))
+
+ (do-template [<name> <tag> <type>]
+ [(def: #export <name>
+ (-> Attributes <type>)
+ (..empty <tag>))]
+
+ [canvas "canvas" Element]
+ [progress "progress" Element]
+ [output "output" Input]
+ [source "source" Source]
+ [track "track" Track]
+ )
+
+ (do-template [<name> <tag>]
+ [(def: #export (<name> attributes media on-unsupported)
+ (-> Attributes Media (Maybe Content) Element)
+ (..tag <tag> attributes
+ (|> on-unsupported
+ (maybe.default (..text ""))
+ (..and media))))]
+
+ [audio "audio"]
+ [video "video"]
+ )
+
+ (def: #export (picture attributes sources image)
+ (-> Attributes Source Image Element)
+ (..tag "picture" attributes (..and sources image)))
(def: #export (anchor href attributes content)
(-> URL Attributes Element Element)
(..tag "a" (list& ["href" href] attributes) content))
- (def: #export (input attributes)
- (-> Attributes Input)
- (|> attributes
- (..open "input")
- :abstraction))
-
- (def: #export (label for)
+ (def: #export label
(-> ID Input)
- (:abstraction
- (format (..open "label" (list ["for" for]))
- (..close "label"))))
+ (|>> ["for"] list (..empty "label")))
+
+ (do-template [<name> <container-tag> <description-tag> <type>]
+ [(def: #export (<name> description attributes content)
+ (-> (Maybe Content) Attributes <type> <type>)
+ (..tag <container-tag> attributes
+ (case description
+ (#.Some description)
+ ($_ ..and
+ (..tag <description-tag> (list) description)
+ content)
+
+ #.None
+ content)))]
+
+ [details "details" "summary" Element]
+ [field-set "fieldset" "legend" Input]
+ [figure "figure" "figcaption" Element]
+ )
- (type: #export Phrase (-> Attributes Content Element))
+ (do-template [<name> <tag> <type>]
+ [(def: #export (<name> attributes content)
+ (-> Attributes (Maybe Content) <type>)
+ (|> content
+ (maybe.default (..text ""))
+ (..tag <tag> attributes)))]
- (type: #export Composite (-> Attributes Element Element))
+ [text-area "textarea" Input]
+ [iframe "iframe" Element]
+ )
- (def: #export (phrase tag)
- (-> Tag Phrase)
- (function (_ attributes content)
- (:abstraction
- (format (..open tag attributes)
- (:representation content)
- (..close tag)))))
+ (type: #export Phrase (-> Attributes Content Element))
(do-template [<name> <tag>]
[(def: #export <name>
Phrase
- (..phrase <tag>))]
+ (..tag <tag>))]
+ [abbrebiation "abbr"]
[block-quote "blockquote"]
[bold "b"]
[cite "cite"]
[code "code"]
[definition "dfn"]
+ [deleted "del"]
[emphasized "em"]
+ [h1 "h1"]
+ [h2 "h2"]
+ [h3 "h3"]
+ [h4 "h4"]
+ [h5 "h5"]
+ [h6 "h6"]
+ [inserted "ins"]
[italic "i"]
[keyboard "kbd"]
[marked "mark"]
+ [meter "meter"]
[pre "pre"]
[quote "q"]
[sample "samp"]
+ [struck "s"]
+ [small "small"]
+ [sub "sub"]
+ [super "sup"]
[strong "strong"]
+ [time "time"]
+ [underlined "u"]
[variable "var"]
)
- (def: #export (composite tag)
- (-> Tag Composite)
- (function (_ attributes content)
- (:abstraction
- (format (..open tag attributes)
- (:representation content)
- (..close tag)))))
+ (def: #export incorrect ..struck)
+
+ (def: (ruby-pronunciation pronunciation)
+ (-> Content (HTML Any))
+ (..tag "rt" (list)
+ ($_ ..and
+ (..tag "rp" (list) (..text "("))
+ pronunciation
+ (..tag "rp" (list) (..text ")")))))
+
+ (def: #export (ruby attributes content pronunciation)
+ (-> Attributes Content Content Element)
+ (..tag "ruby" attributes
+ ($_ ..and
+ content
+ (ruby-pronunciation pronunciation))))
+
+ (type: #export Composite (-> Attributes Element Element))
(do-template [<name> <tag>]
[(def: #export <name>
Composite
- (..composite <tag>))]
+ (..tag <tag>))]
+ [article "article"]
+ [aside "aside"]
+ [dialog "dialog"]
[div "div"]
[footer "footer"]
[header "header"]
+ [main "main"]
+ [navigation "nav"]
[paragraph "p"]
[section "section"]
[span "span"]
)
+ (do-template [<tag> <name> <input>]
+ [(def: <name>
+ (-> <input> (HTML Any))
+ (..tag <tag> (list)))]
+
+ ["dt" term Content]
+ ["dd" description Element]
+ )
+
+ (def: #export (description-list attributes descriptions)
+ (-> Attributes (List [Content Element]) Element)
+ (case (list/map (function (_ [term description])
+ ($_ ..and
+ (..term term)
+ (..description description)))
+ descriptions)
+ #.Nil
+ (..empty "dl" attributes)
+
+ (#.Cons head tail)
+ (..tag "dl" attributes
+ (list/fold (function.flip ..and) head tail))))
+
(def: #export p ..paragraph)
(do-template [<name> <tag> <input> <output>]
@@ -259,23 +464,80 @@
(..tag <tag>))]
[button "button" Element Input]
- [item "li" (HTML Any) Item]
- [ordered "ol" Item Element]
- [unordered "ul" Item Element]
+ [item "li" Element Item]
+ [ordered-list "ol" Item Element]
+ [unordered-list "ul" Item Element]
[option "option" Content Option]
+ [option-group "optgroup" Option Option]
[data-list "datalist" Option Element]
[select "select" Option Input]
+ [address "address" Element Element]
+ [form "form" Input Element]
+ [data "data" Element Element]
+ [object "object" Parameter Element]
)
-
- (do-template [<name> <tag> <element> <container>]
+
+ (do-template [<name> <tag> <input> <output>]
[(def: #export <name>
- (-> <element> <container>)
+ (-> <input> <output>)
(..tag <tag> (list)))]
+ [title "title" Content Meta]
+ [no-script "noscript" Content Meta]
+ [template "template" (HTML Any) (HTML Nothing)]
+ [table-header "th" Element Header]
+ [table-cell "td" Element Cell]
[head "head" Meta Head]
[body "body" Element Body]
)
+ (do-template [<name> <tag> <input> <output>]
+ [(def: <name>
+ (-> <input> <output>)
+ (..tag <tag> (list)))]
+
+ [table-row "tr" (HTML Any) Row]
+ [table-head "thead" Row HTML]
+ [table-body "tbody" Row HTML]
+ [table-foot "tfoot" Row HTML]
+ [columns-group "colgroup" Column HTML]
+ )
+
+ (def: #export (table attributes caption columns headers rows footer)
+ (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element)
+ (let [head (..table-head (..table-row headers))
+ content (case (list/map table-row rows)
+ #.Nil
+ head
+
+ (#.Cons first rest)
+ (..and head
+ (..table-body
+ (list/fold (function.flip ..and) first rest))))
+ content (case footer
+ #.None
+ content
+
+ (#.Some footer)
+ (..and content
+ (..table-foot (..table-row footer))))
+ content (case columns
+ #.None
+ content
+
+ (#.Some columns)
+ (..and (..columns-group columns)
+ content))
+ content (case caption
+ #.None
+ content
+
+ (#.Some caption)
+ (..and (:coerce HTML caption)
+ content))]
+ (..tag "table" attributes
+ content)))
+
(do-template [<name> <doc-type>]
[(def: #export <name>
(-> Head Body Document)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 05:48:14 +0000