diff options
Diffstat (limited to 'stdlib/source/lux/data/format')
| -rw-r--r-- | stdlib/source/lux/data/format/context.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/html.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 316 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/xml.lux | 281 |
5 files changed, 334 insertions, 335 deletions
diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux index 5f0d29b11..a52de9af8 100644 --- a/stdlib/source/lux/data/format/context.lux +++ b/stdlib/source/lux/data/format/context.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser] ["ex" exception #+ exception:] @@ -9,26 +9,26 @@ (exception: #export Unknown-Property) (type: #export Context - (d;Dict Text Text)) + (d.Dict Text Text)) (type: #export (Property a) - (p;Parser Context a)) + (p.Parser Context a)) (def: #export (property name) (-> Text (Property Text)) (function [context] - (case (d;get name context) - (#;Some value) - (ex;return [context value]) + (case (d.get name context) + (#.Some value) + (ex.return [context value]) - #;None - (ex;throw Unknown-Property name)))) + #.None + (ex.throw Unknown-Property name)))) (def: #export (run context property) - (All [a] (-> Context (Property a) (E;Error a))) + (All [a] (-> Context (Property a) (E.Error a))) (case (property context) - (#E;Success [_ output]) - (#E;Success output) + (#E.Success [_ output]) + (#E.Success output) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 2b0a1a03b..4f148110f 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [color #+ Color] [number] @@ -13,7 +13,7 @@ (type: #export Value Text) (type: #export Style - {#;doc "The style associated with a CSS selector."} + {#.doc "The style associated with a CSS selector."} (List [Property Value])) (type: #export Rule [Selector Style]) @@ -26,20 +26,20 @@ (-> Style Text) (|> style (L/map (function [[key val]] (format key ": " val))) - (text;join-with "; "))) + (text.join-with "; "))) (def: #export (css sheet) (-> Sheet CSS) (|> sheet (L/map (function [[selector style]] - (if (list;empty? style) + (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text;join-with "\n"))) + (text.join-with "\n"))) (def: #export (rgb color) (-> Color Value) - (let [[red green blue] (color;unpack color)] + (let [[red green blue] (color.unpack color)] (format "rgb(" (|> red nat-to-int %i) "," (|> green nat-to-int %i) "," (|> blue nat-to-int %i) @@ -47,11 +47,11 @@ (def: #export (rgba color alpha) (-> Color Deg Value) - (let [[red green blue] (color;unpack color)] + (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) + "," (if (d/= (:: number.Interval<Deg> top) alpha) "1.0" (format "0" (%d alpha))) ")"))) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index e33e7d4ee..0c6b1bf0e 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -1,25 +1,25 @@ -(;module: +(.module: [lux #- comment] (lux (data [text] text/format (coll [list "L/" Functor<List>])))) (type: #export Attributes - {#;doc "Attributes for an HTML tag."} + {#.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."} + {#.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 "/" "/"))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "\"" """) + (text.replace-all "'" "'") + (text.replace-all "/" "/"))) (def: #export (comment content) (-> Text HTML) @@ -28,13 +28,13 @@ (def: attrs-to-text (-> Attributes Text) (|>> (L/map (function [[key val]] (format key "=" "\"" (text val) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: #export (tag name attrs children) - {#;doc "Generates the HTML for a tag."} + {#.doc "Generates the HTML for a tag."} (-> Text Attributes (List HTML) HTML) (format "<" name " " (attrs-to-text attrs) ">" - (text;join-with " " children) + (text.join-with " " children) "</" name ">")) (do-template [<name> <doc-type>] @@ -44,7 +44,7 @@ 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\">"] + [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/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index b007dba42..37d6f954f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading and writing values in the JSON format. +(.module: {#.doc "Functionality for reading and writing values in the JSON format. For more information, please see: http://www.json.org/"} [lux #- Array] @@ -49,11 +49,11 @@ ) (type: #export (Reader a) - {#;doc "JSON reader."} - (p;Parser (List JSON) a)) + {#.doc "JSON reader."} + (p.Parser (List JSON) a)) (syntax: #export (json token) - {#;doc (doc "A simple way to produce JSON literals." + {#.doc (doc "A simple way to produce JSON literals." (json true) (json 123.456) (json "Some text") @@ -62,86 +62,86 @@ (json {"this" "is" "an" "object"}))} (let [(^open) Monad<Meta> - wrapper (function [x] (` (;;json (~ x))))] + wrapper (function [x] (` (..json (~ x))))] (case token (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) - ([#;Bool code;bool #Boolean] - [#;Frac code;frac #Number] - [#;Text code;text #String]) + ([#.Bool code.bool #Boolean] + [#.Frac code.frac #Number] + [#.Text code.text #String]) - [_ (#;Tag ["" "null"])] + [_ (#.Tag ["" "null"])] (wrap (list (` (: JSON #Null)))) - [_ (#;Tuple members)] + [_ (#.Tuple members)] (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) - [_ (#;Record pairs)] + [_ (#.Record pairs)] (do Monad<Meta> - [pairs' (monad;map @ + [pairs' (monad.map @ (function [[slot value]] (case slot - [_ (#;Text key-name)] - (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) + [_ (#.Text key-name)] + (wrap (` [(~ (code.text key-name)) (~ (wrapper value))])) _ - (macro;fail "Wrong syntax for JSON object."))) + (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (dict;from-list text;Hash<Text> (list (~@ pairs'))))))))) + (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~@ pairs'))))))))) _ (wrap (list token)) ))) (def: #export (get-fields json) - {#;doc "Get all the fields in a JSON object."} - (-> JSON (e;Error (List String))) + {#.doc "Get all the fields in a JSON object."} + (-> JSON (e.Error (List String))) (case json (#Object obj) - (#e;Success (dict;keys obj)) + (#e.Success (dict.keys obj)) _ - (#e;Error ($_ text/compose "Cannot get the fields of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) - {#;doc "A JSON object field getter."} - (-> String JSON (e;Error JSON)) + {#.doc "A JSON object field getter."} + (-> String JSON (e.Error JSON)) (case json (#Object obj) - (case (dict;get key obj) - (#;Some value) - (#e;Success value) + (case (dict.get key obj) + (#.Some value) + (#e.Success value) - #;None - (#e;Error ($_ text/compose "Missing field \"" key "\" on object."))) + #.None + (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) _ - (#e;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) - {#;doc "A JSON object field setter."} - (-> String JSON JSON (e;Error JSON)) + {#.doc "A JSON object field setter."} + (-> String JSON JSON (e.Error JSON)) (case json (#Object obj) - (#e;Success (#Object (dict;put key value obj))) + (#e.Success (#Object (dict.put key value obj))) _ - (#e;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))} - (-> Text JSON (e;Error <type>)) + {#.doc (code.text ($_ text/compose "A JSON object field getter for " <desc> "."))} + (-> Text JSON (e.Error <type>)) (case (get key json) - (#e;Success (<tag> value)) - (#e;Success value) + (#e.Success (<tag> value)) + (#e.Success value) - (#e;Success _) - (#e;Error ($_ text/compose "Wrong value type at key: " key)) + (#e.Success _) + (#e.Error ($_ text/compose "Wrong value type at key: " key)) - (#e;Error error) - (#e;Error error)))] + (#e.Error error) + (#e.Error error)))] [get-boolean #Boolean Boolean "booleans"] [get-number #Number Number "numbers"] @@ -159,31 +159,31 @@ (^template [<tag> <struct>] [(<tag> x') (<tag> y')] (:: <struct> = x' y')) - ([#Boolean bool;Eq<Bool>] - [#Number number;Eq<Frac>] - [#String text;Eq<Text>]) + ([#Boolean bool.Eq<Bool>] + [#Number number.Eq<Frac>] + [#String text.Eq<Text>]) [(#Array xs) (#Array ys)] - (and (n/= (sequence;size xs) (sequence;size ys)) + (and (n/= (sequence.size xs) (sequence.size ys)) (list/fold (function [idx prev] (and prev - (maybe;default false - (do maybe;Monad<Maybe> - [x' (sequence;nth idx xs) - y' (sequence;nth idx ys)] + (maybe.default false + (do maybe.Monad<Maybe> + [x' (sequence.nth idx xs) + y' (sequence.nth idx ys)] (wrap (= x' y')))))) true - (list;indices (sequence;size xs)))) + (list.indices (sequence.size xs)))) [(#Object xs) (#Object ys)] - (and (n/= (dict;size xs) (dict;size ys)) + (and (n/= (dict.size xs) (dict.size ys)) (list/fold (function [[xk xv] prev] (and prev - (case (dict;get xk ys) - #;None false - (#;Some yv) (= xv yv)))) + (case (dict.get xk ys) + #.None false + (#.Some yv) (= xv yv)))) true - (dict;entries xs))) + (dict.entries xs))) _ false))) @@ -195,40 +195,40 @@ (def: unconsumed-input-error Text "Unconsumed JSON.") (def: #export (run json parser) - (All [a] (-> JSON (Reader a) (e;Error a))) - (case (p;run (list json) parser) - (#e;Success [remainder output]) + (All [a] (-> JSON (Reader a) (e.Error a))) + (case (p.run (list json) parser) + (#e.Success [remainder output]) (case remainder - #;Nil - (#e;Success output) + #.Nil + (#e.Success output) _ - (#e;Error unconsumed-input-error)) + (#e.Error unconsumed-input-error)) - (#e;Error error) - (#e;Error error))) + (#e.Error error) + (#e.Error error))) (def: #export (fail error) (All [a] (-> Text (Reader a))) (function [inputs] - (#e;Error error))) + (#e.Error error))) (def: #export any - {#;doc "Just returns the JSON input without applying any logic."} + {#.doc "Just returns the JSON input without applying any logic."} (Reader JSON) (<| (function [inputs]) (case inputs - #;Nil - (#e;Error "Empty JSON stream.") + #.Nil + (#e.Error "Empty JSON stream.") - (#;Cons head tail) - (#e;Success [tail head])))) + (#.Cons head tail) + (#e.Success [tail head])))) (do-template [<name> <type> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Reads a JSON value as " <desc> "."))} + {#.doc (code.text ($_ text/compose "Reads a JSON value as " <desc> "."))} (Reader <type>) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -245,9 +245,9 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test) - {#;doc (code;text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Reader Bool)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -257,9 +257,9 @@ (fail ($_ text/compose "JSON value is not " <desc> "."))))) (def: #export (<check> test) - {#;doc (code;text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Reader Unit)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -271,30 +271,30 @@ _ (fail ($_ text/compose "JSON value is not a " <desc> ".")))))] - [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id] - [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #Number "number" id] - [string? string! Text text;Eq<Text> text;encode #String "string" id] + [boolean? boolean! Bool bool.Eq<Bool> (:: bool.Codec<Text,Bool> encode) #Boolean "boolean" id] + [number? number! Frac number.Eq<Frac> (:: number.Codec<Text,Frac> encode) #Number "number" id] + [string? string! Text text.Eq<Text> text.encode #String "string" id] ) (def: #export (nullable parser) (All [a] (-> (Reader a) (Reader (Maybe a)))) - (p;alt null + (p.alt null parser)) (def: #export (array parser) - {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON array, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Array values) - (case (p;run (sequence;to-list values) parser) - (#e;Error error) + (case (p.run (sequence.to-list values) parser) + (#e.Error error) (fail error) - (#e;Success [remainder output]) + (#e.Success [remainder output]) (case remainder - #;Nil + #.Nil (wrap output) _ @@ -304,46 +304,46 @@ (fail "JSON value is not an array.")))) (def: #export (object parser) - {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON object, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader (Dict Text a)))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (do e;Monad<Error> + (case (do e.Monad<Error> [] - (|> (dict;entries object) - (monad;map @ (function [[key val]] + (|> (dict.entries object) + (monad.map @ (function [[key val]] (do @ [val (run val parser)] (wrap [key val])))) - (:: @ map (dict;from-list text;Hash<Text>)))) - (#e;Success table) + (:: @ map (dict.from-list text.Hash<Text>)))) + (#e.Success table) (wrap table) - (#e;Error error) + (#e.Error error) (fail error)) _ (fail "JSON value is not an array.")))) (def: #export (field field-name parser) - {#;doc "Parses a field inside a JSON object."} + {#.doc "Parses a field inside a JSON object."} (All [a] (-> Text (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (dict;get field-name object) - (#;Some value) + (case (dict.get field-name object) + (#.Some value) (case (run value parser) - (#e;Success output) + (#e.Success output) (function [tail] - (#e;Success [(#;Cons (#Object (dict;remove field-name object)) + (#e.Success [(#.Cons (#Object (dict.remove field-name object)) tail) output])) - (#e;Error error) + (#e.Error error) (fail error)) _ @@ -360,23 +360,23 @@ (do-template [<name> <type> <codec>] [(def: <name> (-> <type> Text) <codec>)] - [show-boolean Boolean (:: bool;Codec<Text,Bool> encode)] - [show-number Number (:: number;Codec<Text,Frac> encode)] - [show-string String text;encode]) + [show-boolean Boolean (:: bool.Codec<Text,Bool> encode)] + [show-number Number (:: number.Codec<Text,Frac> encode)] + [show-string String text.encode]) (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) ($_ text/compose "[" - (|> elems (sequence/map show-json) sequence;to-list (text;join-with ",")) + (|> elems (sequence/map show-json) sequence.to-list (text.join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) ($_ text/compose "{" (|> object - dict;entries + dict.entries (list/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) - (text;join-with ",")) + (text.join-with ",")) "}")) (def: (show-json json) @@ -394,24 +394,24 @@ )) (def: space~ - (l;Lexer Text) - (l;some l;space)) + (l.Lexer Text) + (l.some l.space)) (def: data-sep - (l;Lexer [Text Unit Text]) - ($_ p;seq space~ (l;this ",") space~)) + (l.Lexer [Text Unit Text]) + ($_ p.seq space~ (l.this ",") space~)) (def: null~ - (l;Lexer Null) - (do p;Monad<Parser> - [_ (l;this "null")] + (l.Lexer Null) + (do p.Monad<Parser> + [_ (l.this "null")] (wrap []))) (do-template [<name> <token> <value>] [(def: <name> - (l;Lexer Boolean) - (do p;Monad<Parser> - [_ (l;this <token>)] + (l.Lexer Boolean) + (do p.Monad<Parser> + [_ (l.this <token>)] (wrap <value>)))] [t~ "true" true] @@ -419,49 +419,49 @@ ) (def: boolean~ - (l;Lexer Boolean) - (p;either t~ f~)) + (l.Lexer Boolean) + (p.either t~ f~)) (def: number~ - (l;Lexer Number) - (do p;Monad<Parser> - [signed? (l;this? "-") - digits (l;many l;decimal) - decimals (p;default "0" + (l.Lexer Number) + (do p.Monad<Parser> + [signed? (l.this? "-") + digits (l.many l.decimal) + decimals (p.default "0" (do @ - [_ (l;this ".")] - (l;many l;decimal))) - exp (p;default "" + [_ (l.this ".")] + (l.many l.decimal))) + exp (p.default "" (do @ - [mark (l;one-of "eE") - signed?' (l;this? "-") - offset (l;many l;decimal)] + [mark (l.one-of "eE") + signed?' (l.this? "-") + offset (l.many l.decimal)] (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) - (#e;Error message) - (p;fail message) + (#e.Error message) + (p.fail message) - (#e;Success value) + (#e.Success value) (wrap value)))) (def: escaped~ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "\\t") (parser/wrap "\t")) - (p;after (l;this "\\b") (parser/wrap "\b")) - (p;after (l;this "\\n") (parser/wrap "\n")) - (p;after (l;this "\\r") (parser/wrap "\r")) - (p;after (l;this "\\f") (parser/wrap "\f")) - (p;after (l;this "\\\"") (parser/wrap "\"")) - (p;after (l;this "\\\\") (parser/wrap "\\")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "\\t") (parser/wrap "\t")) + (p.after (l.this "\\b") (parser/wrap "\b")) + (p.after (l.this "\\n") (parser/wrap "\n")) + (p.after (l.this "\\r") (parser/wrap "\r")) + (p.after (l.this "\\f") (parser/wrap "\f")) + (p.after (l.this "\\\"") (parser/wrap "\"")) + (p.after (l.this "\\\\") (parser/wrap "\\")))) (def: string~ - (l;Lexer String) - (<| (l;enclosed ["\"" "\""]) + (l.Lexer String) + (<| (l.enclosed ["\"" "\""]) (loop [_ []]) - (do p;Monad<Parser> - [chars (l;some (l;none-of "\\\"")) - stop l;peek]) + (do p.Monad<Parser> + [chars (l.some (l.none-of "\\\"")) + stop l.peek]) (if (text/= "\\" stop) (do @ [escaped escaped~ @@ -470,34 +470,34 @@ (wrap chars)))) (def: (kv~ json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer [String JSON])) - (do p;Monad<Parser> + (-> (-> Unit (l.Lexer JSON)) (l.Lexer [String JSON])) + (do p.Monad<Parser> [key string~ _ space~ - _ (l;this ":") + _ (l.this ":") _ space~ value (json~ [])] (wrap [key value]))) (do-template [<name> <type> <open> <close> <elem-parser> <prep>] [(def: (<name> json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer <type>)) - (do p;Monad<Parser> - [_ (l;this <open>) + (-> (-> Unit (l.Lexer JSON)) (l.Lexer <type>)) + (do p.Monad<Parser> + [_ (l.this <open>) _ space~ - elems (p;sep-by data-sep <elem-parser>) + elems (p.sep-by data-sep <elem-parser>) _ space~ - _ (l;this <close>)] + _ (l.this <close>)] (wrap (<prep> elems))))] - [array~ Array "[" "]" (json~ []) sequence;from-list] - [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash<Text>)] + [array~ Array "[" "]" (json~ []) sequence.from-list] + [object~ Object "{" "}" (kv~ json~) (dict.from-list text.Hash<Text>)] ) (def: (json~' _) - (-> Unit (l;Lexer JSON)) - ($_ p;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) + (-> Unit (l.Lexer JSON)) + ($_ p.alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) (struct: #export _ (Codec Text JSON) (def: encode show-json) - (def: decode (function [input] (l;run input (json~' []))))) + (def: decode (function [input] (l.run input (json~' []))))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 957628e94..2d7e0a6f4 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading, generating and processing values in the XML format."} +(.module: {#.doc "Functionality for reading, generating and processing values in the XML format."} lux (lux (control monad [eq #+ Eq] @@ -13,174 +13,173 @@ [maybe "m/" Monad<Maybe>] [ident "ident/" Eq<Ident> Codec<Text,Ident>] (coll [list "L/" Monad<List>] - ["d" dict])) - )) + ["d" dict])))) (type: #export Tag Ident) -(type: #export Attrs (d;Dict Ident Text)) +(type: #export Attrs (d.Dict Ident Text)) -(def: #export attrs Attrs (d;new ident;Hash<Ident>)) +(def: #export attrs Attrs (d.new ident.Hash<Ident>)) (type: #export #rec XML (#Text Text) (#Node Tag Attrs (List XML))) (def: xml-standard-escape-char^ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "<") (p/wrap "<")) - (p;after (l;this ">") (p/wrap ">")) - (p;after (l;this "&") (p/wrap "&")) - (p;after (l;this "'") (p/wrap "'")) - (p;after (l;this """) (p/wrap "\"")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "<") (p/wrap "<")) + (p.after (l.this ">") (p/wrap ">")) + (p.after (l.this "&") (p/wrap "&")) + (p.after (l.this "'") (p/wrap "'")) + (p.after (l.this """) (p/wrap "\"")))) (def: xml-unicode-escape-char^ - (l;Lexer Text) - (|> (do p;Monad<Parser> - [hex? (p;maybe (l;this "x")) + (l.Lexer Text) + (|> (do p.Monad<Parser> + [hex? (p.maybe (l.this "x")) code (case hex? - #;None - (p;codec number;Codec<Text,Int> (l;many l;decimal)) + #.None + (p.codec number.Codec<Text,Int> (l.many l.decimal)) - (#;Some _) - (p;codec number;Hex@Codec<Text,Int> (l;many l;hexadecimal)))] - (wrap (|> code int-to-nat text;from-code))) - (p;before (l;this ";")) - (p;after (l;this "&#")))) + (#.Some _) + (p.codec number.Hex@Codec<Text,Int> (l.many l.hexadecimal)))] + (wrap (|> code int-to-nat text.from-code))) + (p.before (l.this ";")) + (p.after (l.this "&#")))) (def: xml-escape-char^ - (l;Lexer Text) - (p;either xml-standard-escape-char^ + (l.Lexer Text) + (p.either xml-standard-escape-char^ xml-unicode-escape-char^)) (def: xml-char^ - (l;Lexer Text) - (p;either (l;none-of "<>&'\"") + (l.Lexer Text) + (p.either (l.none-of "<>&'\"") xml-escape-char^)) (def: xml-identifier - (l;Lexer Text) - (do p;Monad<Parser> - [head (p;either (l;one-of "_") - l;alpha) - tail (l;some (p;either (l;one-of "_.-") - l;alpha-num))] + (l.Lexer Text) + (do p.Monad<Parser> + [head (p.either (l.one-of "_") + l.alpha) + tail (l.some (p.either (l.one-of "_.-") + l.alpha-num))] (wrap ($_ text/compose head tail)))) (def: namespaced-symbol^ - (l;Lexer Ident) - (do p;Monad<Parser> + (l.Lexer Ident) + (do p.Monad<Parser> [first-part xml-identifier - ?second-part (<| p;maybe (p;after (l;this ":")) xml-identifier)] + ?second-part (<| p.maybe (p.after (l.this ":")) xml-identifier)] (case ?second-part - #;None + #.None (wrap ["" first-part]) - (#;Some second-part) + (#.Some second-part) (wrap [first-part second-part])))) (def: tag^ namespaced-symbol^) (def: attr-name^ namespaced-symbol^) (def: spaced^ - (All [a] (-> (l;Lexer a) (l;Lexer a))) - (let [white-space^ (p;some l;space)] - (|>> (p;before white-space^) - (p;after white-space^)))) + (All [a] (-> (l.Lexer a) (l.Lexer a))) + (let [white-space^ (p.some l.space)] + (|>> (p.before white-space^) + (p.after white-space^)))) (def: attr-value^ - (l;Lexer Text) - (let [value^ (l;some xml-char^)] - (p;either (l;enclosed ["\"" "\""] value^) - (l;enclosed ["'" "'"] value^)))) + (l.Lexer Text) + (let [value^ (l.some xml-char^)] + (p.either (l.enclosed ["\"" "\""] value^) + (l.enclosed ["'" "'"] value^)))) (def: attrs^ - (l;Lexer Attrs) - (<| (:: p;Monad<Parser> map (d;from-list ident;Hash<Ident>)) - p;some - (p;seq (spaced^ attr-name^)) - (p;after (l;this "=")) + (l.Lexer Attrs) + (<| (:: p.Monad<Parser> map (d.from-list ident.Hash<Ident>)) + p.some + (p.seq (spaced^ attr-name^)) + (p.after (l.this "=")) (spaced^ attr-value^))) (def: (close-tag^ expected) - (-> Tag (l;Lexer [])) - (do p;Monad<Parser> + (-> Tag (l.Lexer [])) + (do p.Monad<Parser> [actual (|> tag^ spaced^ - (p;after (l;this "/")) - (l;enclosed ["<" ">"]))] - (p;assert ($_ text/compose "Close tag does not match open tag.\n" + (p.after (l.this "/")) + (l.enclosed ["<" ">"]))] + (p.assert ($_ text/compose "Close tag does not match open tag.\n" "Expected: " (ident/encode expected) "\n" " Actual: " (ident/encode actual) "\n") (ident/= expected actual)))) (def: comment^ - (l;Lexer Text) - (|> (l;not (l;this "--")) - l;some - (l;enclosed ["<--" "-->"]) + (l.Lexer Text) + (|> (l.not (l.this "--")) + l.some + (l.enclosed ["<--" "-->"]) spaced^)) (def: xml-header^ - (l;Lexer Attrs) + (l.Lexer Attrs) (|> (spaced^ attrs^) - (p;before (l;this "?>")) - (p;after (l;this "<?xml")) + (p.before (l.this "?>")) + (p.after (l.this "<?xml")) spaced^)) (def: cdata^ - (l;Lexer Text) - (let [end (l;this "]]>")] - (|> (l;some (l;not end)) - (p;after end) - (p;after (l;this "<![CDATA[")) + (l.Lexer Text) + (let [end (l.this "]]>")] + (|> (l.some (l.not end)) + (p.after end) + (p.after (l.this "<![CDATA[")) spaced^))) (def: text^ - (l;Lexer XML) - (|> (p;either cdata^ - (l;many xml-char^)) + (l.Lexer XML) + (|> (p.either cdata^ + (l.many xml-char^)) (p/map (|>> #Text)))) (def: xml^ - (l;Lexer XML) - (|> (p;rec + (l.Lexer XML) + (|> (p.rec (function [node^] - (p;either text^ + (p.either text^ (spaced^ - (do p;Monad<Parser> - [_ (l;this "<") + (do p.Monad<Parser> + [_ (l.this "<") tag (spaced^ tag^) attrs (spaced^ attrs^) - #let [no-children^ (do p;Monad<Parser> - [_ (l;this "/>")] + #let [no-children^ (do p.Monad<Parser> + [_ (l.this "/>")] (wrap (#Node tag attrs (list)))) - with-children^ (do p;Monad<Parser> - [_ (l;this ">") - children (p;some node^) + with-children^ (do p.Monad<Parser> + [_ (l.this ">") + children (p.some node^) _ (close-tag^ tag)] (wrap (#Node tag attrs children)))]] - (p;either no-children^ + (p.either no-children^ with-children^)))))) ## This is put outside of the call to "rec" because comments ## cannot be located inside of XML nodes. ## This way, the comments can only be before or after the main document. - (p;before (p;some comment^)) - (p;after (p;some comment^)) - (p;after (p;maybe xml-header^)))) + (p.before (p.some comment^)) + (p.after (p.some comment^)) + (p.after (p.maybe xml-header^)))) (def: #export (read input) - (-> Text (E;Error XML)) - (l;run input xml^)) + (-> Text (E.Error XML)) + (l.run input xml^)) (def: (sanitize-value input) (-> Text Text) (|> input - (text;replace-all "&" "&") - (text;replace-all "<" "<") - (text;replace-all ">" ">") - (text;replace-all "'" "'") - (text;replace-all "\"" """))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "'" "'") + (text.replace-all "\"" """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -191,10 +190,10 @@ (def: (write-attrs attrs) (-> Attrs Text) (|> attrs - d;entries + d.entries (L/map (function [[key value]] ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: xml-header Text @@ -210,15 +209,15 @@ (#Node xml-tag xml-attrs xml-children) (let [tag (write-tag xml-tag) - attrs (if (d;empty? xml-attrs) + attrs (if (d.empty? xml-attrs) "" ($_ text/compose " " (write-attrs xml-attrs)))] - (if (list;empty? xml-children) + (if (list.empty? xml-children) ($_ text/compose "<" tag attrs "/>") ($_ text/compose "<" tag attrs ">" (|> xml-children (L/map recur) - (text;join-with "")) + (text.join-with "")) "</" tag ">"))))))) (struct: #export _ (Codec Text XML) @@ -234,17 +233,17 @@ [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] (and (ident/= reference/tag sample/tag) - (:: (d;Eq<Dict> text;Eq<Text>) = reference/attrs sample/attrs) - (n/= (list;size reference/children) - (list;size sample/children)) - (|> (list;zip2 reference/children sample/children) - (list;every? (product;uncurry =)))) + (:: (d.Eq<Dict> text.Eq<Text>) = reference/attrs sample/attrs) + (n/= (list.size reference/children) + (list.size sample/children)) + (|> (list.zip2 reference/children sample/children) + (list.every? (product.uncurry =)))) _ false))) (type: #export (Reader a) - (p;Parser (List XML) a)) + (p.Parser (List XML) a)) (exception: #export Empty-Input) (exception: #export Unexpected-Input) @@ -256,81 +255,81 @@ (Reader Text) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text value) - (#E;Success [tail value]) + (#E.Success [tail value]) (#Node _) - (ex;throw Unexpected-Input ""))))) + (ex.throw Unexpected-Input ""))))) (def: #export (attr name) (-> Ident (Reader Text)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node tag attrs children) - (case (d;get name attrs) - #;None - (ex;throw Unknown-Attribute "") + (case (d.get name attrs) + #.None + (ex.throw Unknown-Attribute "") - (#;Some value) - (#E;Success [docs value])))))) + (#.Some value) + (#E.Success [docs value])))))) (def: (run' docs reader) - (All [a] (-> (List XML) (Reader a) (E;Error a))) - (case (p;run docs reader) - (#E;Success [remaining output]) - (if (list;empty? remaining) - (#E;Success output) - (ex;throw Unconsumed-Inputs (|> remaining + (All [a] (-> (List XML) (Reader a) (E.Error a))) + (case (p.run docs reader) + (#E.Success [remaining output]) + (if (list.empty? remaining) + (#E.Success output) + (ex.throw Unconsumed-Inputs (|> remaining (L/map (:: Codec<Text,XML> encode)) - (text;join-with "\n\n")))) + (text.join-with "\n\n")))) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export (node tag) (-> Ident (Reader Unit)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) (if (ident/= tag _tag) - (#E;Success [docs []]) - (ex;throw Wrong-Tag (ident/encode tag))))))) + (#E.Success [docs []]) + (ex.throw Wrong-Tag (ident/encode tag))))))) (def: #export (children reader) (All [a] (-> (Reader a) (Reader a))) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) - (do E;Monad<Error> + (do E.Monad<Error> [output (run' _children reader)] (wrap [tail output])))))) @@ -338,12 +337,12 @@ (Reader Unit) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) - (#E;Success [tail []])))) + (#.Cons head tail) + (#E.Success [tail []])))) (def: #export (run document reader) - (All [a] (-> XML (Reader a) (E;Error a))) + (All [a] (-> XML (Reader a) (E.Error a))) (run' (list document) reader)) |