diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 316 |
1 files changed, 158 insertions, 158 deletions
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~' []))))) |