diff options
| -rw-r--r-- | stdlib/source/lux/data/format/css.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/html.lux | 50 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 12 |
3 files changed, 154 insertions, 3 deletions
diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux new file mode 100644 index 000000000..a5adfb928 --- /dev/null +++ b/stdlib/source/lux/data/format/css.lux @@ -0,0 +1,95 @@ +(;module: + lux + (lux (data [color #+ Color] + [number] + [text] + text/format + (coll [list "L/" Functor<List> Monoid<List>])))) + +(type: #export Selector + Text) + +(type: #export Property Text) +(type: #export Value Text) + +(type: #export Style + {#;doc "The style associated with a CSS selector."} + (List [Property Value])) + +(type: #export Rule [Selector Style]) + +(type: #export Sheet (List Rule)) + +(type: #export CSS Text) + +(def: #export (inline style) + (-> Style Text) + (|> style + (L/map (function [[key val]] (format key ": " val))) + (text;join-with "; "))) + +(def: #export (css sheet) + (-> Sheet CSS) + (|> sheet + (L/map (function [[selector style]] + (if (list;empty? style) + "" + (format selector "{" (inline style) "}")))) + (text;join-with "\n"))) + +(def: #export (rgb color) + (-> Color Value) + (let [[red green blue] (color;unpack color)] + (format "rgb(" (|> red nat-to-int %i) + "," (|> green nat-to-int %i) + "," (|> blue nat-to-int %i) + ")"))) + +(def: #export (rgba color alpha) + (-> Color Deg Value) + (let [[red green blue] (color;unpack color)] + (format "rgba(" (|> red nat-to-int %i) + "," (|> green nat-to-int %i) + "," (|> blue nat-to-int %i) + "," (if (d.= (:: number;Interval<Deg> top) alpha) + "1.0" + (format "0" (%d alpha))) + ")"))) + +(def: #export (rule selector style children) + (-> Selector Style Sheet Sheet) + (list& [selector style] + (L/map (function [[sub-selector sub-style]] + [(format selector sub-selector) sub-style]) + children))) + +(do-template [<name> <type>] + [(def: #export <name> + (-> <type> <type> <type>) + L/append)] + + [merge Style] + [cascade Sheet] + ) + +(do-template [<name> <suffix>] + [(def: #export (<name> value) + (-> Real Value) + (format (%r value) <suffix>))] + + [em "em"] + [ex "ex"] + [rem "rem"] + [ch "ch"] + [vw "vw"] + [vh "vh"] + [vmin "vmin"] + [vmax "vmax"] + [% "%"] + [cm "cm"] + [mm "mm"] + [in "in"] + [px "px"] + [pt "pt"] + [pc "pc"] + ) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux new file mode 100644 index 000000000..e594b2232 --- /dev/null +++ b/stdlib/source/lux/data/format/html.lux @@ -0,0 +1,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 "&" "&") + (text;replace-all "<" "<") + (text;replace-all ">" ">") + (text;replace-all "\"" """) + (text;replace-all "'" "'") + (text;replace-all "/" "/"))) + +(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\">"] + ) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 2f1da760f..ee503c94c 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -37,6 +37,7 @@ ["_;" sum] ["_;" text] ["_;" lazy] + ["_;" color] (number ["_;" ratio] ["_;" complex]) (format ["_;" json] @@ -69,6 +70,8 @@ (type ["_;" check] ["_;" auto] ["_;" object]) + (world ["_;" blob] + ["_;" fs]) )) (lux (control [contract] [concatenative]) @@ -76,12 +79,15 @@ (data [env] [trace] [store] - [tainted]) + [tainted] + (format [context] + [html] + [css])) [macro] (math [random]) - (type [unit])) + (type [unit]) + [world/env]) ) -## [Program] (program: args (test;run)) |