diff options
author | Eduardo Julian | 2019-01-09 20:15:34 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-01-09 20:15:34 -0400 |
commit | 8ed04489e19d4693e9c96b88313f34a840d41190 (patch) | |
tree | f5ac32fe9602e8e9679c812d91c8a93ee50abd7e /stdlib/source | |
parent | 4ddbc26a1e30a9323ac4f55bdf6992c540bbe207 (diff) |
Expanded HTML machinery.
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux/data/format/html.lux | 317 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/http.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/http/response.lux | 11 |
3 files changed, 293 insertions, 41 deletions
diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index 45a7117ad..b260a8768 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -1,53 +1,294 @@ (.module: - [lux (#- comment) + [lux (#- Meta comment and) [data + ["." maybe] ["." text format] - [collection [list ("list/." Functor<List>)]]]]) + [collection + [list ("list/." Functor<List>)]]] + [type + abstract] + [world + [net (#+ URL)]]] + [// + ["." css (#+ CSS)]]) + +(type: #export Tag Text) + +(type: #export ID Text) (type: #export Attributes {#.doc "Attributes for an HTML tag."} (List [Text Text])) -(type: #export HTML Text) +(type: #export Script Text) + +(type: #export Target + #Blank + #Parent + #Self + #Top + (#Frame Text)) -(def: #export (text value) +(def: (target value) + (-> Target Text) + (case value + #Blank "_blank" + #Parent "_parent" + #Self "_self" + #Top "_top" + (#Frame name) name)) + +(def: sanitize {#.doc "Properly formats text to ensure no injection can happen on the HTML."} - (-> Text HTML) - (|> value - (text.replace-all "&" "&") - (text.replace-all "<" "<") - (text.replace-all ">" ">") - (text.replace-all text.double-quote """) - (text.replace-all "'" "'") - (text.replace-all "/" "/"))) - -(def: #export (comment content) - (-> Text HTML) - (format "<!--" (text content) "-->")) - -(def: attrs-to-text + (-> Text Text) + (|>> (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all text.double-quote """) + (text.replace-all "'" "'") + (text.replace-all "/" "/"))) + +(def: attributes (-> Attributes Text) - (|>> (list/map (function (_ [key val]) (format key "=" text.double-quote (text val) text.double-quote))) + (|>> (list/map (function (_ [key val]) + (format key "=" text.double-quote (..sanitize val) text.double-quote))) (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> - (-> HTML HTML) - (let [doc-type <doc-type>] - (function (_ document) - (format doc-type - document))))] - - [html-5 "<!DOCTYPE html>"] - [html-4_01 (format "<!DOCTYPE HTML PUBLIC " text.double-quote "-//W3C//DTD HTML 4.01//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/html4/strict.dtd" text.double-quote ">")] - [xhtml-1_0 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double-quote ">")] - [xhtml-1_1 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.1//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double-quote ">")] +(def: (open tag attributes) + (-> Tag Attributes Text) + (|> attributes + ..attributes + (format tag " ") + (text.enclose ["<" ">"]))) + +(def: close + (-> Tag Text) + (text.enclose ["</" ">"])) + +(abstract: #export (HTML kind) + {} + + Text + + (do-template [<name> <kind>] + [(abstract: #export <kind> {} Any) + (type: #export <name> (HTML <kind>))] + + [Meta Meta'] + [Head Head'] + [Item Item'] + [Option Option'] + [Input Input'] + [Body Body'] + [Document Document'] + ) + + (abstract: #export (Element' brand) {} Any) + (type: #export Element (HTML (Element' Any))) + + (abstract: #export Content' {} Any) + (type: #export Content (HTML (Element' Content'))) + + (def: #export html + (-> (HTML Any) Text) + (|>> :representation)) + + (def: #export (and pre post) + (All [kind] (-> (HTML kind) (HTML kind) (HTML kind))) + (:abstraction (format (:representation pre) (:representation post)))) + + (def: #export (comment content node) + (All [brand] (-> Text (HTML brand) (HTML brand))) + (:abstraction + (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))))) + + (do-template [<name> <tag>] + [(def: #export <name> + (-> Attributes Meta) + (|>> (..open <tag>) + :abstraction))] + + [link "link"] + [meta "meta"] + ) + + (def: #export (base href target) + (-> URL (Maybe Target) Meta) + (let [partial (list ["href" href]) + full (case target + (#.Some target) + (list& ["target" (..target target)] partial) + + #.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"] + ) + + (def: #export (style css) + (-> CSS Meta) + (:abstraction + (format (..open "style" (list)) + css + (..close "style")))) + + (def: #export (script attributes inline) + (-> Attributes (Maybe Script) Meta) + (:abstraction + (format (..open "script" attributes) + (maybe.default "" inline) + (..close "script")))) + + (def: #export text + (-> Text Content) + (|>> ..sanitize + :abstraction)) + + (do-template [<tag> <alias> <name>] + [(def: #export <name> + Element + (:abstraction (..open <tag> (list)))) + + (def: #export <alias> <name>)] + ["br" br break] + ["hr" hr separator] + ) + + (def: #export (image source attributes) + (-> URL Attributes Element) + (|> attributes + (#.Cons ["src" source]) + (..open "img") + :abstraction)) + + (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) + (-> ID Input) + (:abstraction + (format (..open "label" (list ["for" for])) + (..close "label")))) + + (type: #export Phrase (-> Attributes Content Element)) + + (type: #export Composite (-> Attributes Element Element)) + + (def: #export (phrase tag) + (-> Tag Phrase) + (function (_ attributes content) + (:abstraction + (format (..open tag attributes) + (:representation content) + (..close tag))))) + + (do-template [<name> <tag>] + [(def: #export <name> + Phrase + (..phrase <tag>))] + + [block-quote "blockquote"] + [bold "b"] + [cite "cite"] + [code "code"] + [definition "dfn"] + [emphasized "em"] + [italic "i"] + [keyboard "kbd"] + [marked "mark"] + [pre "pre"] + [quote "q"] + [sample "samp"] + [strong "strong"] + [variable "var"] + ) + + (def: #export (composite tag) + (-> Tag Composite) + (function (_ attributes content) + (:abstraction + (format (..open tag attributes) + (:representation content) + (..close tag))))) + + (do-template [<name> <tag>] + [(def: #export <name> + Composite + (..composite <tag>))] + + [div "div"] + [footer "footer"] + [header "header"] + [paragraph "p"] + [section "section"] + [span "span"] + ) + + (def: #export p ..paragraph) + + (do-template [<name> <tag> <input> <output>] + [(def: #export <name> + (-> Attributes <input> <output>) + (..tag <tag>))] + + [button "button" Element Input] + [item "li" (HTML Any) Item] + [ordered "ol" Item Element] + [unordered "ul" Item Element] + [option "option" Content Option] + [data-list "datalist" Option Element] + [select "select" Option Input] + ) + + (do-template [<name> <tag> <element> <container>] + [(def: #export <name> + (-> <element> <container>) + (..tag <tag> (list)))] + + [head "head" Meta Head] + [body "body" Element Body] + ) + + (do-template [<name> <doc-type>] + [(def: #export <name> + (-> Head Body Document) + (let [doc-type <doc-type>] + (function (_ head body) + (|> (..tag "html" (list) (..and head body)) + :representation + (format doc-type) + :abstraction))))] + + [html-5 "<!DOCTYPE html>"] + [html-4_01 (format "<!DOCTYPE HTML PUBLIC " text.double-quote "-//W3C//DTD HTML 4.01//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/html4/strict.dtd" text.double-quote ">")] + [xhtml-1_0 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double-quote ">")] + [xhtml-1_1 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.1//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double-quote ">")] + ) ) diff --git a/stdlib/source/lux/world/net/http.lux b/stdlib/source/lux/world/net/http.lux index 04e7ef829..b518858a6 100644 --- a/stdlib/source/lux/world/net/http.lux +++ b/stdlib/source/lux/world/net/http.lux @@ -62,15 +62,15 @@ #query Context #form (Maybe Context)}) -(type: #export Payload +(type: #export Message {#headers Context #body Body}) (type: #export Request - [Identification Protocol Resource Payload]) + [Identification Protocol Resource Message]) (type: #export Response - [Status Payload]) + [Status Message]) (type: #export Server (-> Request (Promise Response))) diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux index fc23dfd20..624b0167c 100644 --- a/stdlib/source/lux/world/net/http/response.lux +++ b/stdlib/source/lux/world/net/http/response.lux @@ -7,6 +7,8 @@ ["." text format ["." encoding]] + [format + ["." html (#+ HTML)]] [collection ["." array] ["." dictionary (#+ Dictionary)]]] @@ -53,3 +55,12 @@ (header.content-length (binary.size data)) (header.content-type mime.text)) #//.body (channel/wrap data)}])) + +(def: #export (html content) + (-> (HTML Any) Response) + (let [data (encoding.to-utf8 (html.html content))] + [status.ok + {#//.headers (|> (dictionary.new text.Hash<Text>) + (header.content-length (binary.size data)) + (header.content-type mime.html)) + #//.body (channel/wrap data)}])) |