diff options
Diffstat (limited to 'stdlib/source/poly/lux/data/format/json.lux')
| -rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 318 |
1 files changed, 159 insertions, 159 deletions
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index e838c73b4..9e4a6a369 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -129,97 +129,97 @@ (function (_ type) (` (-> (~ (poly.code *env* type)) /.JSON))))] inputT <type>.next] - ($_ <>.either - <basic> - <time> - (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) - <type>.any))] - (in (` (is (~ (@JSON#encoded inputT)) - (# (~! qty_codec) (~' encoded)))))) - (do ! - [.let [g!_ (code.local "_______") - g!key (code.local "_______key") - g!val (code.local "_______val")] - [_ _ =val=] (<type>.applied ($_ <>.and - (<type>.exactly dictionary.Dictionary) - (<type>.exactly .Text) + (all <>.either + <basic> + <time> + (do ! + [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + <type>.any))] + (in (` (is (~ (@JSON#encoded inputT)) + (# (~! qty_codec) (~' encoded)))))) + (do ! + [.let [g!_ (code.local "_______") + g!key (code.local "_______key") + g!val (code.local "_______val")] + [_ _ =val=] (<type>.applied (all <>.and + (<type>.exactly dictionary.Dictionary) + (<type>.exactly .Text) + encoded))] + (in (` (is (~ (@JSON#encoded inputT)) + (|>> ((~! dictionary.entries)) + ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! dictionary.of_list) (~! text.hash)) + {/.#Object}))))) + (do ! + [[_ =sub=] (<type>.applied (all <>.and + (<type>.exactly .Maybe) encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - (|>> ((~! dictionary.entries)) - ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! dictionary.of_list) (~! text.hash)) - {/.#Object}))))) - (do ! - [[_ =sub=] (<type>.applied ($_ <>.and - (<type>.exactly .Maybe) - encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - ((~! ..nullable) (~ =sub=)))))) - (do ! - [[_ =sub=] (<type>.applied ($_ <>.and - (<type>.exactly .List) - encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array}))))) - (do ! - [.let [g!_ (code.local "_______") - g!input (code.local "_______input")] - members (<type>.variant (<>.many encoded)) - .let [last (-- (list.size members))]] - (in (` (is (~ (@JSON#encoded inputT)) - (function ((~ g!_) (~ g!input)) - (case (~ g!input) - (~+ (list#conjoint (list#each (function (_ [tag g!encoded]) - (if (n.= last tag) - (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)}) - (` ((~! /.json) [(~ (code.frac (..tag (-- tag)))) - #1 - ((~ g!encoded) (~ g!input))]))) - (.list (` {(~ (code.nat tag)) #0 (~ g!input)}) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encoded) (~ g!input))]))))) - (list.enumeration members)))))))))) - (do ! - [g!encoders (<type>.tuple (<>.many encoded)) - .let [g!_ (code.local "_______") - g!members (|> (list.size g!encoders) - list.indices - (list#each (|>> n#encoded code.local)))]] - (in (` (is (~ (@JSON#encoded inputT)) - (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded]) - (` ((~ g!encoded) (~ g!member)))) - (list.zipped_2 g!members g!encoders)))])))))) - ... Type recursion - (do ! - [[selfC non_recC] (<type>.recursive encoded) - .let [g! (code.local "____________")]] - (in (` (is (~ (@JSON#encoded inputT)) - ((~! ..rec_encoded) (.function ((~ g!) (~ selfC)) - (~ non_recC))))))) - <type>.recursive_self - ... Type applications - (do ! - [partsC (<type>.applied (<>.many encoded))] - (in (` ((~+ partsC))))) - ... Polymorphism - (do ! - [[funcC varsC bodyC] (<type>.polymorphic encoded)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) - (-> ((~ (poly.code *env* inputT)) (~+ varsC)) - /.JSON))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - <type>.parameter - <type>.recursive_call - ... If all else fails... - (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT))) - )))) + (in (` (is (~ (@JSON#encoded inputT)) + ((~! ..nullable) (~ =sub=)))))) + (do ! + [[_ =sub=] (<type>.applied (all <>.and + (<type>.exactly .List) + encoded))] + (in (` (is (~ (@JSON#encoded inputT)) + (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array}))))) + (do ! + [.let [g!_ (code.local "_______") + g!input (code.local "_______input")] + members (<type>.variant (<>.many encoded)) + .let [last (-- (list.size members))]] + (in (` (is (~ (@JSON#encoded inputT)) + (function ((~ g!_) (~ g!input)) + (case (~ g!input) + (~+ (list#conjoint (list#each (function (_ [tag g!encoded]) + (if (n.= last tag) + (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)}) + (` ((~! /.json) [(~ (code.frac (..tag (-- tag)))) + #1 + ((~ g!encoded) (~ g!input))]))) + (.list (` {(~ (code.nat tag)) #0 (~ g!input)}) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encoded) (~ g!input))]))))) + (list.enumeration members)))))))))) + (do ! + [g!encoders (<type>.tuple (<>.many encoded)) + .let [g!_ (code.local "_______") + g!members (|> (list.size g!encoders) + list.indices + (list#each (|>> n#encoded code.local)))]] + (in (` (is (~ (@JSON#encoded inputT)) + (function ((~ g!_) [(~+ g!members)]) + ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded]) + (` ((~ g!encoded) (~ g!member)))) + (list.zipped_2 g!members g!encoders)))])))))) + ... Type recursion + (do ! + [[selfC non_recC] (<type>.recursive encoded) + .let [g! (code.local "____________")]] + (in (` (is (~ (@JSON#encoded inputT)) + ((~! ..rec_encoded) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) + <type>.recursive_self + ... Type applications + (do ! + [partsC (<type>.applied (<>.many encoded))] + (in (` ((~+ partsC))))) + ... Polymorphism + (do ! + [[funcC varsC bodyC] (<type>.polymorphic encoded)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) + (-> ((~ (poly.code *env* inputT)) (~+ varsC)) + /.JSON))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + <type>.parameter + <type>.recursive_call + ... If all else fails... + (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT))) + )))) (poly: decoded (with_expansions @@ -253,76 +253,76 @@ (function (_ type) (` (</>.Parser (~ (poly.code *env* type))))))] inputT <type>.next] - ($_ <>.either - <basic> - <time> - (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) - <type>.any))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) - (do ! - [[_ _ valC] (<type>.applied ($_ <>.and - (<type>.exactly dictionary.Dictionary) - (<type>.exactly .Text) - decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.dictionary) (~ valC)))))) - (do ! - [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) - decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.nullable) (~ subC)))))) - (do ! - [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) + (all <>.either + <basic> + <time> + (do ! + [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + <type>.any))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) + (do ! + [[_ _ valC] (<type>.applied (all <>.and + (<type>.exactly dictionary.Dictionary) + (<type>.exactly .Text) decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.array) ((~! <>.some) (~ subC))))))) - (do ! - [members (<type>.variant (<>.many decoded)) - .let [last (-- (list.size members))]] - (in (` (is (~ (@JSON#decoded inputT)) - ($_ ((~! <>.or)) - (~+ (list#each (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1)))) - ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0)))) - ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) - (do ! - [g!decoders (<type>.tuple (<>.many decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) - ... Type recursion - (do ! - [[selfC bodyC] (<type>.recursive decoded) - .let [g! (code.local "____________")]] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! <>.rec) (.function ((~ g!) (~ selfC)) - (~ bodyC))))))) - <type>.recursive_self - ... Type applications - (do ! - [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))] - (in (` ((~ funcC) (~+ argsC))))) - ... Polymorphism - (do ! - [[funcC varsC bodyC] (<type>.polymorphic decoded)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - <type>.parameter - <type>.recursive_call - ... If all else fails... - (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT))) - )))) + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.dictionary) (~ valC)))))) + (do ! + [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) + decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.nullable) (~ subC)))))) + (do ! + [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) + decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.array) ((~! <>.some) (~ subC))))))) + (do ! + [members (<type>.variant (<>.many decoded)) + .let [last (-- (list.size members))]] + (in (` (is (~ (@JSON#decoded inputT)) + (all ((~! <>.or)) + (~+ (list#each (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1)))) + ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0)))) + ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) + (do ! + [g!decoders (<type>.tuple (<>.many decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.array) (all ((~! <>.and)) (~+ g!decoders))))))) + ... Type recursion + (do ! + [[selfC bodyC] (<type>.recursive decoded) + .let [g! (code.local "____________")]] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! <>.rec) (.function ((~ g!) (~ selfC)) + (~ bodyC))))))) + <type>.recursive_self + ... Type applications + (do ! + [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))] + (in (` ((~ funcC) (~+ argsC))))) + ... Polymorphism + (do ! + [[funcC varsC bodyC] (<type>.polymorphic decoded)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC)) + (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + <type>.parameter + <type>.recursive_call + ... If all else fails... + (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT))) + )))) (syntax: .public (codec [inputT <code>.any]) (in (.list (` (is (codec.Codec /.JSON (~ inputT)) |