diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 186 |
1 files changed, 93 insertions, 93 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 61a104555..6d7ed16a7 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -4,7 +4,7 @@ lux (lux (control functor applicative - monad + ["M" monad #+ do Monad] [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) @@ -90,15 +90,15 @@ [_ (#;Record pairs)] (do Monad<Lux> - [pairs' (mapM @ - (function [[slot value]] - (case slot - [_ (#;Text key-name)] - (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) - - _ - (macro;fail "Wrong syntax for JSON object."))) - pairs)] + [pairs' (M;map @ + (function [[slot value]] + (case slot + [_ (#;Text key-name)] + (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) + + _ + (macro;fail "Wrong syntax for JSON object."))) + pairs)] (wrap (list (` (: JSON (#Object (d;from-list text;Hash<Text> (list (~@ pairs'))))))))) _ @@ -449,7 +449,7 @@ (case json (#Array values) (do R;Monad<Result> - [elems (mapM @ parser (vector;to-list values))] + [elems (M;map @ parser (vector;to-list values))] (wrap elems)) _ @@ -462,12 +462,12 @@ (case json (#Object fields) (do R;Monad<Result> - [kvs (mapM @ - (function [[key val']] - (do @ - [val (parser val')] - (wrap [key val]))) - (d;entries fields))] + [kvs (M;map @ + (function [[key val']] + (do @ + [val (parser val')] + (wrap [key val]))) + (d;entries fields))] (wrap (d;from-list text;Hash<Text> kvs))) _ @@ -761,14 +761,14 @@ (with-gensyms [g!type-fun g!case g!input] (do @ [members (poly;sum+ :x:) - pattern-matching (mapM @ - (function [[tag :case:]] - (do @ - [g!encode (Codec<JSON,?>//encode env :case:)] - (wrap (list (` ((~ (code;nat tag)) (~ g!case))) - (` (;;json [(~ (code;int (nat-to-int tag))) - ((~ g!encode) (~ g!case))])))))) - (list;enumerate members))] + pattern-matching (M;map @ + (function [[tag :case:]] + (do @ + [g!encode (Codec<JSON,?>//encode env :case:)] + (wrap (list (` ((~ (code;nat tag)) (~ g!case))) + (` (;;json [(~ (code;int (nat-to-int tag))) + ((~ g!encode) (~ g!case))])))))) + (list;enumerate members))] (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:))) (function [(~ g!input)] (case (~ g!input) @@ -779,15 +779,15 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [#let [tag (code;tag name)] - encoder (Codec<JSON,?>//encode new-env :case:)] - (wrap (list (` ((~ tag) (~ g!case))) - (` (;;json [(~ (code;text (product;right name))) - ((~ encoder) (~ g!case))])))))) - members) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [#let [tag (code;tag name)] + encoder (Codec<JSON,?>//encode new-env :case:)] + (wrap (list (` ((~ tag) (~ g!case))) + (` (;;json [(~ (code;text (product;right name))) + ((~ encoder) (~ g!case))])))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -807,13 +807,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - synthesis (mapM @ - (function [[name :slot:]] - (do @ - [encoder (Codec<JSON,?>//encode new-env :slot:)] - (wrap [(` (~ (code;text (product;right name)))) - (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))]))) - members) + synthesis (M;map @ + (function [[name :slot:]] + (do @ + [encoder (Codec<JSON,?>//encode new-env :slot:)] + (wrap [(` (~ (code;text (product;right name)))) + (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -832,13 +832,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [:member:] - (do @ - [g!member (macro;gensym "g!member") - encoder (Codec<JSON,?>//encode new-env :member:)] - (wrap [g!member encoder]))) - members) + pattern-matching (M;map @ + (function [:member:] + (do @ + [g!member (macro;gensym "g!member") + encoder (Codec<JSON,?>//encode new-env :member:)] + (wrap [g!member encoder]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -870,7 +870,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Codec<JSON,?>//encode env :func:) - .args. (mapM @ (Codec<JSON,?>//encode env) :args:)] + .args. (M;map @ (Codec<JSON,?>//encode env) :args:)] (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-vars @@ -918,13 +918,13 @@ (function [(~ g!input)] (do R;Monad<Result> [(~ g!key) (;;fields (~ g!input)) - (~ g!output) (mapM R;Monad<Result> - (function [(~ g!key)] - (do R;Monad<Result> - [(~ g!val) (;;get (~ g!key) (~ g!input)) - (~ g!val) (;;run (~ g!val) (~ .val.))] - ((~ (' wrap)) [(~ g!key) (~ g!val)]))) - (~ g!key))] + (~ g!output) (M;map R;Monad<Result> + (function [(~ g!key)] + (do R;Monad<Result> + [(~ g!val) (;;get (~ g!key) (~ g!input)) + (~ g!val) (;;run (~ g!val) (~ .val.))] + ((~ (' wrap)) [(~ g!key) (~ g!val)]))) + (~ g!key))] ((~' wrap) (d;from-list text;Hash<Text> (~ g!output))))) ))) )) @@ -932,15 +932,15 @@ (with-gensyms [g!type-fun g!case g!input g!_] (do @ [members (poly;sum+ :x:) - pattern-matching (mapM @ - (function [[tag :case:]] - (do @ - [g!decode (Codec<JSON,?>//decode env :case:)] - (wrap (list (` (do Monad<Parser> - [(~ g!_) (;;nth +0 (;;int! (~ (code;int (nat-to-int tag))))) - (~ g!_) (;;nth +1 (~ g!decode))] - ((~' wrap) ((~ (code;nat tag)) (~ g!_))))))))) - (list;enumerate members))] + pattern-matching (M;map @ + (function [[tag :case:]] + (do @ + [g!decode (Codec<JSON,?>//decode env :case:)] + (wrap (list (` (do Monad<Parser> + [(~ g!_) (;;nth +0 (;;int! (~ (code;int (nat-to-int tag))))) + (~ g!_) (;;nth +1 (~ g!decode))] + ((~' wrap) ((~ (code;nat tag)) (~ g!_))))))))) + (list;enumerate members))] (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:))) ($_ ;;either (~@ (L/join pattern-matching)))))))) @@ -950,16 +950,16 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [#let [tag (code;tag name)] - decoder (Codec<JSON,?>//decode new-env :case:)] - (wrap (list (` (do Monad<Parser> - [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name))))) - (~ g!_) (;;nth +1 (~ decoder))] - ((~ (' wrap)) ((~ tag) (~ g!_))))))))) - members) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [#let [tag (code;tag name)] + decoder (Codec<JSON,?>//decode new-env :case:)] + (wrap (list (` (do Monad<Parser> + [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name))))) + (~ g!_) (;;nth +1 (~ decoder))] + ((~ (' wrap)) ((~ tag) (~ g!_))))))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -984,16 +984,16 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - extraction (mapM @ - (function [[name :slot:]] - (do @ - [#let [g!member (code;symbol ["" (product;right name)])] - decoder (Codec<JSON,?>//decode new-env :slot:)] - (wrap (list g!member - (` (;;get (~ (code;text (product;right name))) (~ g!input))) - g!member - (` ((~ decoder) (~ g!member))))))) - members) + extraction (M;map @ + (function [[name :slot:]] + (do @ + [#let [g!member (code;symbol ["" (product;right name)])] + decoder (Codec<JSON,?>//decode new-env :slot:)] + (wrap (list g!member + (` (;;get (~ (code;text (product;right name))) (~ g!input))) + g!member + (` ((~ decoder) (~ g!member))))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -1016,13 +1016,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [:member:] - (do @ - [g!member (macro;gensym "g!member") - decoder (Codec<JSON,?>//decode new-env :member:)] - (wrap [g!member decoder]))) - members) + pattern-matching (M;map @ + (function [:member:] + (do @ + [g!member (macro;gensym "g!member") + decoder (Codec<JSON,?>//decode new-env :member:)] + (wrap [g!member decoder]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -1055,7 +1055,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Codec<JSON,?>//decode env :func:) - .args. (mapM @ (Codec<JSON,?>//decode env) :args:)] + .args. (M;map @ (Codec<JSON,?>//decode env) :args:)] (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-vars |