diff options
Diffstat (limited to 'stdlib/source/lux/data/format/json.lux')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 94 |
1 files changed, 51 insertions, 43 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index a213fa1d0..b68101e3c 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -5,7 +5,7 @@ ["." monad (#+ Monad do)] [equivalence (#+ Equivalence)] codec - ["p" parser (#+ Parser) ("#;." monad)] + ["p" parser (#+ Parser) ("#@." monad)] ["ex" exception (#+ exception:)]] [data ["." bit] @@ -14,12 +14,12 @@ ["." sum] ["." product] [number - ["." frac ("#;." decimal)]] - ["." text ("#;." equivalence monoid) + ["." frac ("#@." decimal)]] + ["." text ("#@." equivalence monoid) ["l" lexer]] [collection - ["." list ("#;." fold monad)] - ["." row (#+ Row row) ("#;." monad)] + ["." list ("#@." fold monad)] + ["." row (#+ Row row) ("#@." monad)] ["." dictionary (#+ Dictionary)]]] ["." macro (#+ monad with-gensyms) ["s" syntax (#+ syntax:)] @@ -76,7 +76,7 @@ (wrap (list (` (: JSON #Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#Array ((~! row) (~+ (list;map wrapper members)))))))) + (wrap (list (` (: JSON (#Array ((~! row) (~+ (list@map wrapper members)))))))) [_ (#.Record pairs)] (do ..monad @@ -102,7 +102,7 @@ (#error.Success (dictionary.keys obj)) _ - (#error.Failure ($_ text;compose "Cannot get the fields of a non-object.")))) + (#error.Failure ($_ text@compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) {#.doc "A JSON object field getter."} @@ -114,10 +114,10 @@ (#error.Success value) #.None - (#error.Failure ($_ text;compose "Missing field '" key "' on object."))) + (#error.Failure ($_ text@compose "Missing field '" key "' on object."))) _ - (#error.Failure ($_ text;compose "Cannot get field '" key "' of a non-object.")))) + (#error.Failure ($_ text@compose "Cannot get field '" key "' of a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -127,18 +127,18 @@ (#error.Success (#Object (dictionary.put key value obj))) _ - (#error.Failure ($_ text;compose "Cannot set field '" key "' of a non-object.")))) + (#error.Failure ($_ 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> "."))} + {#.doc (code.text ($_ text@compose "A JSON object field getter for " <desc> "."))} (-> Text JSON (Error <type>)) (case (get key json) (#error.Success (<tag> value)) (#error.Success value) (#error.Success _) - (#error.Failure ($_ text;compose "Wrong value type at key: " key)) + (#error.Failure ($_ text@compose "Wrong value type at key: " key)) (#error.Failure error) (#error.Failure error)))] @@ -165,7 +165,7 @@ [(#Array xs) (#Array ys)] (and (n/= (row.size xs) (row.size ys)) - (list;fold (function (_ idx prev) + (list@fold (function (_ idx prev) (and prev (maybe.default #0 (do maybe.monad @@ -177,7 +177,7 @@ [(#Object xs) (#Object ys)] (and (n/= (dictionary.size xs) (dictionary.size ys)) - (list;fold (function (_ [xk xv] prev) + (list@fold (function (_ [xk xv] prev) (and prev (case (dictionary.get xk ys) #.None #0 @@ -208,16 +208,16 @@ (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) - ($_ text;compose "[" - (|> elems (row;map show-json) row.to-list (text.join-with ",")) + ($_ text@compose "[" + (|> elems (row@map show-json) row.to-list (text.join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) - ($_ text;compose "{" + ($_ text@compose "{" (|> object dictionary.entries - (list;map (function (_ [key value]) ($_ text;compose (show-string key) ":" (show-json value)))) + (list@map (function (_ [key value]) ($_ text@compose (show-string key) ":" (show-json value)))) (text.join-with ",")) "}")) @@ -241,7 +241,7 @@ (exception: #export (unconsumed-input {input (List JSON)}) (|> input - (list;map show-json) + (list@map show-json) (text.join-with text.new-line))) (exception: #export (empty-input) @@ -279,7 +279,7 @@ (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 [head any] @@ -288,7 +288,7 @@ (wrap value) _ - (fail ($_ text;compose "JSON value is not " <desc> ".")))))] + (fail ($_ text@compose "JSON value is not " <desc> ".")))))] [null Any #Null "null"] [boolean Bit #Boolean "boolean"] @@ -298,7 +298,7 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc>] [(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 Bit)) (do p.monad [head any] @@ -307,10 +307,10 @@ (wrap (:: <eq> = test value)) _ - (fail ($_ text;compose "JSON value is not " <desc> "."))))) + (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 Any)) (do p.monad [head any] @@ -318,10 +318,10 @@ (<tag> value) (if (:: <eq> = test value) (wrap []) - (fail ($_ text;compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value)))) + (fail ($_ text@compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value)))) _ - (fail ($_ text;compose "JSON value is not a " <desc> ".")))))] + (fail ($_ text@compose "JSON value is not a " <desc> ".")))))] [boolean? boolean! Bit bit.equivalence encode-boolean #Boolean "boolean"] [number? number! Frac frac.equivalence (:: frac.decimal encode) #Number "number"] @@ -353,7 +353,7 @@ (fail (ex.construct unconsumed-input remainder)))) _ - (fail (text;compose "JSON value is not an array: " (show-json head)))))) + (fail (text@compose "JSON value is not an array: " (show-json head)))))) (def: #export (object parser) {#.doc "Parses a JSON object. Use this with the 'field' combinator."} @@ -364,7 +364,7 @@ (#Object kvs) (case (p.run (|> kvs dictionary.entries - (list;map (function (_ [key value]) + (list@map (function (_ [key value]) (list (#String key) value))) list.concat) parser) @@ -380,7 +380,7 @@ (fail (ex.construct unconsumed-input remainder)))) _ - (fail (text;compose "JSON value is not an object: " (show-json head)))))) + (fail (text@compose "JSON value is not an object: " (show-json head)))))) (def: #export (field field-name parser) {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} @@ -388,7 +388,7 @@ (function (recur inputs) (case inputs (^ (list& (#String key) value inputs')) - (if (text;= key field-name) + (if (text@= key field-name) (case (p.run (list value) parser) (#error.Success [#.Nil output]) (#error.Success [inputs' output]) @@ -409,6 +409,14 @@ _ (ex.throw unconsumed-input inputs)))) +(def: #export dictionary + {#.doc "Parses a dictionary-like JSON object."} + (All [a] (-> (Reader a) (Reader (Dictionary Text a)))) + (|>> (p.and ..string) + p.some + object + (p@map (dictionary.from-list text.hash)))) + ############################################################ ############################################################ ############################################################ @@ -456,8 +464,8 @@ [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)) + (wrap ($_ text@compose mark (if signed?' "-" "") offset))))] + (case (frac@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp)) (#error.Failure message) (p.fail message) @@ -468,32 +476,32 @@ (l.Lexer Text) ($_ p.either (p.after (l.this "\t") - (p;wrap text.tab)) + (p@wrap text.tab)) (p.after (l.this "\b") - (p;wrap text.back-space)) + (p@wrap text.back-space)) (p.after (l.this "\n") - (p;wrap text.new-line)) + (p@wrap text.new-line)) (p.after (l.this "\r") - (p;wrap text.carriage-return)) + (p@wrap text.carriage-return)) (p.after (l.this "\f") - (p;wrap text.form-feed)) - (p.after (l.this (text;compose "\" text.double-quote)) - (p;wrap text.double-quote)) + (p@wrap text.form-feed)) + (p.after (l.this (text@compose "\" text.double-quote)) + (p@wrap text.double-quote)) (p.after (l.this "\\") - (p;wrap "\")))) + (p@wrap "\")))) (def: string~ (l.Lexer String) (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do p.monad - [chars (l.some (l.none-of (text;compose "\" text.double-quote))) + [chars (l.some (l.none-of (text@compose "\" text.double-quote))) stop l.peek]) - (if (text;= "\" stop) + (if (text@= "\" stop) (do @ [escaped escaped~ next-chars (recur [])] - (wrap ($_ text;compose chars escaped next-chars))) + (wrap ($_ text@compose chars escaped next-chars))) (wrap chars)))) (def: (kv~ json~) |