diff options
Diffstat (limited to 'stdlib/source/lux/data/format/json.lux')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 84 |
1 files changed, 42 insertions, 42 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 153920700..91bd9c2fd 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -72,7 +72,7 @@ (json {"this" "is" "an" "object"}))} (let [(^open) Monad<Lux> - wrapper (lambda [x] (` (;;json (~ x))))] + wrapper (function [x] (` (;;json (~ x))))] (case token (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] @@ -91,7 +91,7 @@ [_ (#;RecordS pairs)] (do Monad<Lux> [pairs' (mapM @ - (lambda [[slot value]] + (function [[slot value]] (case slot [_ (#;TextS key-name)] (wrap (` [(~ (ast;text key-name)) (~ (wrapper value))])) @@ -125,7 +125,7 @@ (format "{" (|> object dict;entries - (List/map (lambda [[key value]] (format (:: text;Codec<Text,Text> encode key) ":" (show-json value)))) + (List/map (function [[key value]] (format (:: text;Codec<Text,Text> encode key) ":" (show-json value)))) (text;join-with ",")) "}")) @@ -220,7 +220,7 @@ (def: #export (gen-nullable gen) {#;doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (Gen a) (Gen (Maybe a)))) - (lambda [elem] + (function [elem] (case elem #;None #Null (#;Some value) (gen value)))) @@ -349,7 +349,7 @@ ## [Structures] (struct: #export _ (Functor Parser) (def: (map f ma) - (lambda [json] + (function [json] (case (ma json) (#;Left msg) (#;Left msg) @@ -364,7 +364,7 @@ (#;Right x)) (def: (apply ff fa) - (lambda [json] + (function [json] (case (ff json) (#;Right f) (case (fa json) @@ -381,7 +381,7 @@ (def: applicative Applicative<Parser>) (def: (join mma) - (lambda [json] + (function [json] (case (mma json) (#;Left msg) (#;Left msg) @@ -494,7 +494,7 @@ (def: #export (nullable parser) {#;doc "A parser that can handle the presence of null values."} (All [a] (-> (Parser a) (Parser (Maybe a)))) - (lambda [json] + (function [json] (case json #Null (#;Right #;None) @@ -511,7 +511,7 @@ (def: #export (array parser) {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."} (All [a] (-> (Parser a) (Parser (List a)))) - (lambda [json] + (function [json] (case json (#Array values) (do Monad<Error> @@ -524,12 +524,12 @@ (def: #export (object parser) {#;doc "Parses a JSON object, assuming that every field's value can be parsed the same way."} (All [a] (-> (Parser a) (Parser (Dict String a)))) - (lambda [json] + (function [json] (case json (#Object fields) (do Monad<Error> [kvs (mapM @ - (lambda [[key val']] + (function [[key val']] (do @ [val (parser val')] (wrap [key val]))) @@ -542,7 +542,7 @@ (def: #export (nth idx parser) {#;doc "Parses an element inside a JSON array."} (All [a] (-> Nat (Parser a) (Parser a))) - (lambda [json] + (function [json] (case json (#Array values) (case (vector;nth idx values) @@ -563,7 +563,7 @@ (def: #export (field field-name parser) {#;doc "Parses a field inside a JSON object."} (All [a] (-> Text (Parser a) (Parser a))) - (lambda [json] + (function [json] (case (get field-name json) (#;Some value) (case (parser value) @@ -579,7 +579,7 @@ (def: #export any {#;doc "Just returns the JSON input without applying any logic."} (Parser JSON) - (lambda [json] + (function [json] (#;Right json))) (def: #export (seq pa pb) @@ -680,7 +680,7 @@ [(#Array xs) (#Array ys)] (and (n.= (vector;size xs) (vector;size ys)) - (fold (lambda [idx prev] + (fold (function [idx prev] (and prev (default false (do Monad<Maybe> @@ -692,7 +692,7 @@ [(#Object xs) (#Object ys)] (and (n.= (dict;size xs) (dict;size ys)) - (fold (lambda [[xk xv] prev] + (fold (function [[xk xv] prev] (and prev (case (dict;get xk ys) #;None false @@ -705,7 +705,7 @@ (struct: #export _ (Codec Text JSON) (def: encode show-json) - (def: decode (lambda [input] (lexer;run input (json~' []))))) + (def: decode (function [input] (lexer;run input (json~' []))))) ## [Syntax] (type: Shape @@ -728,13 +728,13 @@ (let [array-size (list;size parts) parsers (|> parts (list;zip2 (list;indices array-size)) - (List/map (lambda [[idx parser]] + (List/map (function [[idx parser]] (` (nth (~ (ast;nat idx)) (~ parser))))))] (wrap (list (` ($_ seq (~@ parsers)))))) (#ObjectShape kvs) (let [fields (List/map product;left kvs) - parsers (List/map (lambda [[field-name parser]] + parsers (List/map (function [[field-name parser]] (` (field (~ (ast;text field-name)) (~ parser)))) kvs)] (wrap (list (` ($_ seq (~@ parsers)))))) @@ -751,14 +751,14 @@ (let [array-size (list;size parts) parsers (|> parts (list;zip2 (list;indices array-size)) - (List/map (lambda [[idx parser]] + (List/map (function [[idx parser]] (` (nth (~ (ast;nat idx)) (~ parser))))))] (wrap (list (` (ensure (array-size! (~ (ast;nat array-size))) ($_ seq (~@ parsers))))))) (#ObjectShape kvs) (let [fields (List/map product;left kvs) - parsers (List/map (lambda [[field-name parser]] + parsers (List/map (function [[field-name parser]] (` (field (~ (ast;text field-name)) (~ parser)))) kvs)] (wrap (list (` (ensure (object-fields! (list (~@ (List/map ast;text fields)))) @@ -772,11 +772,11 @@ (poly: #hidden (Codec<JSON,?>//encode *env* :x:) (let [->Codec//encode (: (-> AST AST) - (lambda [.type.] (` (-> (~ .type.) JSON))))] + (function [.type.] (` (-> (~ .type.) JSON))))] (let% [<basic> (do-template [<type> <matcher> <encoder>] [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//encode (` <type>))) <encoder>))))] - [Unit poly;unit (lambda [(~ (ast;symbol ["" "0"]))] #Null)] + [Unit poly;unit (function [(~ (ast;symbol ["" "0"]))] #Null)] [Bool poly;bool ;;gen-boolean] [Int poly;int (|>. ;int-to-real ;;gen-number)] [Real poly;real ;;gen-number] @@ -809,11 +809,11 @@ (-> (~@ (List/map ->Codec//encode g!vars)) (~ (->Codec//encode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ g!input)] + (function [(~@ g!vars) (~ g!input)] (|> (~ g!input) (_map_ (: (-> [Text (~ (type;to-ast :val:))] [Text JSON]) - (lambda [[(~ g!key) (~ g!val)]] + (function [[(~ g!key) (~ g!val)]] [(~ g!key) ((~ .val.) (~ g!val))]))) ;;object)) @@ -836,7 +836,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] pattern-matching (mapM @ - (lambda [[name :case:]] + (function [[name :case:]] (do @ [#let [tag (ast;tag name)] encoder (Codec<JSON,?>//encode new-*env* :case:)] @@ -853,7 +853,7 @@ (-> (~@ (List/map ->Codec//encode g!vars)) (~ (->Codec//encode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ g!input)] + (function [(~@ g!vars) (~ g!input)] (case (~ g!input) (~@ (List/join pattern-matching)))) ))))) @@ -864,7 +864,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] synthesis (mapM @ - (lambda [[name :slot:]] + (function [[name :slot:]] (do @ [encoder (Codec<JSON,?>//encode new-*env* :slot:)] (wrap [(` (~ (ast;text (product;right name)))) @@ -879,7 +879,7 @@ (-> (~@ (List/map ->Codec//encode g!vars)) (~ (->Codec//encode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ g!input)] + (function [(~@ g!vars) (~ g!input)] (;;json (~ (ast;record synthesis)))) ))))) (with-gensyms [g!type-fun g!case] @@ -889,7 +889,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] pattern-matching (mapM @ - (lambda [:member:] + (function [:member:] (do @ [g!member (compiler;gensym "g!member") encoder (Codec<JSON,?>//encode new-*env* :member:)] @@ -905,8 +905,8 @@ (~ (->Codec//encode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))] #let [.tuple. (` [(~@ (List/map product;left pattern-matching))])]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ .tuple.)] - (;;json [(~@ (List/map (lambda [[g!member g!encoder]] + (function [(~@ g!vars) (~ .tuple.)] + (;;json [(~@ (List/map (function [[g!member g!encoder]] (` ((~ g!encoder) (~ g!member)))) pattern-matching))])) ))) @@ -923,7 +923,7 @@ (poly: #hidden (Codec<JSON,?>//decode *env* :x:) (let [->Codec//decode (: (-> AST AST) - (lambda [.type.] (` (-> JSON (Error (~ .type.))))))] + (function [.type.] (` (-> JSON (Error (~ .type.))))))] (let% [<basic> (do-template [<type> <matcher> <decoder>] [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//decode (` <type>))) <decoder>))))] @@ -968,11 +968,11 @@ (-> (~@ (List/map ->Codec//decode g!vars)) (~ (->Codec//decode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ g!input)] + (function [(~@ g!vars) (~ g!input)] (do Monad<Error> [(~ g!key) (;;fields (~ g!input))] (mapM (~ (' %)) - (lambda [(~ g!key)] + (function [(~ g!key)] (do Monad<Error> [(~ g!val) (;;get (~ g!key) (~ g!input)) (~ g!val) (;;run (~ g!val) (~ .val.))] @@ -988,7 +988,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] pattern-matching (mapM @ - (lambda [[name :case:]] + (function [[name :case:]] (do @ [#let [tag (ast;tag name)] decoder (Codec<JSON,?>//decode new-*env* :case:)] @@ -1012,7 +1012,7 @@ base-parser _ - (` (lambda [(~@ g!vars)] (~ base-parser))))]] + (` (function [(~@ g!vars)] (~ base-parser))))]] (wrap (` (: (~ :x:+) (~ parser)))) )) (with-gensyms [g!type-fun g!case g!input] @@ -1022,7 +1022,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] extraction (mapM @ - (lambda [[name :slot:]] + (function [[name :slot:]] (do @ [#let [g!member (ast;symbol ["" (product;right name)])] decoder (Codec<JSON,?>//decode new-*env* :slot:)] @@ -1040,10 +1040,10 @@ (-> (~@ (List/map ->Codec//decode g!vars)) (~ (->Codec//decode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]] (wrap (` (: (~ :x:+) - (lambda [(~@ g!vars) (~ g!input)] + (function [(~@ g!vars) (~ g!input)] (do Monad<Error> [(~@ (List/join extraction))] - ((~ (' wrap)) (~ (ast;record (List/map (lambda [[name :slot:]] + ((~ (' wrap)) (~ (ast;record (List/map (function [[name :slot:]] [(ast;tag name) (ast;symbol ["" (product;right name)])]) members)))))) ))))) @@ -1054,7 +1054,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) *env*)] pattern-matching (mapM @ - (lambda [:member:] + (function [:member:] (do @ [g!member (compiler;gensym "g!member") decoder (Codec<JSON,?>//decode new-*env* :member:)] @@ -1073,7 +1073,7 @@ (` (;;shape [(~@ (List/map product;right pattern-matching))])) _ - (` (lambda [(~@ g!vars)] + (` (function [(~@ g!vars)] (;;shape [(~@ (List/map product;right pattern-matching))]))))]] (wrap (` (: (~ :x:+) (~ .decoder.)))) )) |