diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/poly/lux/abstract/equivalence.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 139 |
2 files changed, 72 insertions, 71 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index bcb2574bc..bc633d1ed 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -131,8 +131,8 @@ [g!eqs (<type>.tuple (<>.many equivalence)) .let [g!_ (code.local_identifier "_____________") indices (list.indices (list.size g!eqs)) - g!lefts (list\map (|>> nat\encode (text\compose "left") code.local_identifier) indices) - g!rights (list\map (|>> nat\encode (text\compose "right") code.local_identifier) indices)]] + g!lefts (list\map (|>> nat\encoded (text\compose "left") code.local_identifier) indices) + g!rights (list\map (|>> nat\encoded (text\compose "right") code.local_identifier) indices)]] (in (` (: (~ (@Equivalence inputT)) (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) (and (~+ (|> (list.zipped/3 g!eqs g!lefts g!rights) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 1496026a7..be290d301 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -44,12 +44,12 @@ (-> Nat Frac) (|>> .int int.frac)) -(def: (rec_encode non_rec) +(def: (rec_encoded non_rec) (All [a] (-> (-> (-> a JSON) (-> a JSON)) (-> a JSON))) (function (_ input) - (non_rec (rec_encode non_rec) input))) + (non_rec (rec_encoded non_rec) input))) (def: low_mask Nat (|> 1 (i64.left_shifted 32) --)) (def: high_mask Nat (|> low_mask (i64.left_shifted 32))) @@ -57,12 +57,12 @@ (implementation: nat_codec (codec.Codec JSON Nat) - (def: (encode input) + (def: (encoded input) (let [high (|> input (i64.and high_mask) (i64.right_shifted 32)) low (i64.and low_mask input)] (#/.Array (row (|> high .int int.frac #/.Number) (|> low .int int.frac #/.Number))))) - (def: decode + (def: decoded (</>.result (</>.array (do <>.monad [high </>.number @@ -73,9 +73,10 @@ (implementation: int_codec (codec.Codec JSON Int) - (def: encode (|>> .nat (\ nat_codec encode))) - (def: decode - (|>> (\ nat_codec decode) (\ try.functor map .int)))) + (def: encoded + (|>> .nat (\ nat_codec encoded))) + (def: decoded + (|>> (\ nat_codec decoded) (\ try.functor map .int)))) (def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} @@ -89,33 +90,33 @@ (All [unit] (codec.Codec JSON (unit.Qty unit))) - (def: encode + (def: encoded (|>> ((debug.private unit.out)) - (\ ..int_codec encode))) - (def: decode - (|>> (\ ..int_codec decode) + (\ ..int_codec encoded))) + (def: decoded + (|>> (\ ..int_codec decoded) (\ try.functor map (debug.private unit.in))))) -(poly: encode +(poly: encoded (with_expansions [<basic> (template [<matcher> <encoder>] [(do ! [.let [g!_ (code.local_identifier "_______")] _ <matcher>] - (in (` (: (~ (@JSON\encode inputT)) + (in (` (: (~ (@JSON\encoded inputT)) <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] [(<type>.sub Bit) (|>> #/.Boolean)] - [(<type>.sub Nat) (\ (~! ..nat_codec) (~' encode))] - [(<type>.sub Int) (\ (~! ..int_codec) (~' encode))] + [(<type>.sub Nat) (\ (~! ..nat_codec) (~' encoded))] + [(<type>.sub Int) (\ (~! ..int_codec) (~' encoded))] [(<type>.sub Frac) (|>> #/.Number)] [(<type>.sub Text) (|>> #/.String)]) <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (in (` (: (~ (@JSON\encode inputT)) - (|>> (\ (~! <codec>) (~' encode)) #/.String)))))] + (in (` (: (~ (@JSON\encoded inputT)) + (|>> (\ (~! <codec>) (~' encoded)) #/.String)))))] ... [duration.Duration duration.codec] ... [instant.Instant instant.codec] @@ -124,9 +125,9 @@ [month.Month month.codec])] (do {! <>.monad} [*env* <type>.env - .let [@JSON\encode (: (-> Type Code) - (function (_ type) - (` (-> (~ (poly.code *env* type)) /.JSON))))] + .let [@JSON\encoded (: (-> Type Code) + (function (_ type) + (` (-> (~ (poly.code *env* type)) /.JSON))))] inputT <type>.next] ($_ <>.either <basic> @@ -134,8 +135,8 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (in (` (: (~ (@JSON\encode inputT)) - (\ (~! qty_codec) (~' encode)))))) + (in (` (: (~ (@JSON\encoded inputT)) + (\ (~! qty_codec) (~' encoded)))))) (do ! [.let [g!_ (code.local_identifier "_______") g!key (code.local_identifier "_______key") @@ -143,8 +144,8 @@ [_ _ =val=] (<type>.applied ($_ <>.and (<type>.exactly dictionary.Dictionary) (<type>.exactly .Text) - encode))] - (in (` (: (~ (@JSON\encode inputT)) + encoded))] + (in (` (: (~ (@JSON\encoded inputT)) (|>> ((~! dictionary.entries)) ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) [(~ g!key) ((~ =val=) (~ g!val))])) @@ -153,60 +154,60 @@ (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .Maybe) - encode))] - (in (` (: (~ (@JSON\encode inputT)) + encoded))] + (in (` (: (~ (@JSON\encoded inputT)) ((~! ..nullable) (~ =sub=)))))) (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .List) - encode))] - (in (` (: (~ (@JSON\encode inputT)) + encoded))] + (in (` (: (~ (@JSON\encoded inputT)) (|>> ((~! list\map) (~ =sub=)) ((~! row.of_list)) #/.Array))))) (do ! [.let [g!_ (code.local_identifier "_______") g!input (code.local_identifier "_______input")] - members (<type>.variant (<>.many encode)) + members (<type>.variant (<>.many encoded)) .let [last (-- (list.size members))]] - (in (` (: (~ (@JSON\encode inputT)) + (in (` (: (~ (@JSON\encoded inputT)) (function ((~ g!_) (~ g!input)) (case (~ g!input) - (~+ (list\join (list\map (function (_ [tag g!encode]) + (~+ (list\join (list\map (function (_ [tag g!encoded]) (if (n.= last tag) (.list (` ((~ (code.nat (-- tag))) #1 (~ g!input))) (` ((~! /.json) [(~ (code.frac (..tag (-- tag)))) #1 - ((~ g!encode) (~ g!input))]))) + ((~ g!encoded) (~ g!input))]))) (.list (` ((~ (code.nat tag)) #0 (~ g!input))) (` ((~! /.json) [(~ (code.frac (..tag tag))) #0 - ((~ g!encode) (~ g!input))]))))) + ((~ g!encoded) (~ g!input))]))))) (list.enumeration members)))))))))) (do ! - [g!encoders (<type>.tuple (<>.many encode)) + [g!encoders (<type>.tuple (<>.many encoded)) .let [g!_ (code.local_identifier "_______") g!members (|> (list.size g!encoders) list.indices - (list\map (|>> n\encode code.local_identifier)))]] - (in (` (: (~ (@JSON\encode inputT)) + (list\map (|>> n\encoded code.local_identifier)))]] + (in (` (: (~ (@JSON\encoded inputT)) (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) - (` ((~ g!encode) (~ g!member)))) + ((~! /.json) [(~+ (list\map (function (_ [g!member g!encoded]) + (` ((~ g!encoded) (~ g!member)))) (list.zipped/2 g!members g!encoders)))])))))) ... Type recursion (do ! - [[selfC non_recC] (<type>.recursive encode) + [[selfC non_recC] (<type>.recursive encoded) .let [g! (code.local_identifier "____________")]] - (in (` (: (~ (@JSON\encode inputT)) - ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) - (~ non_recC))))))) + (in (` (: (~ (@JSON\encoded inputT)) + ((~! ..rec_encoded) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) <type>.recursive_self ... Type applications (do ! - [partsC (<type>.applied (<>.many encode))] + [partsC (<type>.applied (<>.many encoded))] (in (` ((~+ partsC))))) ... Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic encode)] + [[funcC varsC bodyC] (<type>.polymorphic encoded)] (in (` (: (All [(~+ varsC)] (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) varsC)) @@ -220,12 +221,12 @@ (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT))) )))) -(poly: decode +(poly: decoded (with_expansions [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] - (in (` (: (~ (@JSON\decode inputT)) + (in (` (: (~ (@JSON\decoded inputT)) (~! <decoder>)))))] [(<type>.exactly Any) </>.null] @@ -237,7 +238,7 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (in (` (: (~ (@JSON\decode inputT)) + (in (` (: (~ (@JSON\decoded inputT)) ((~! <>.codec) (~! <codec>) (~! </>.string))))))] ... [duration.Duration duration.codec] @@ -247,9 +248,9 @@ [month.Month month.codec])] (do {! <>.monad} [*env* <type>.env - .let [@JSON\decode (: (-> Type Code) - (function (_ type) - (` (</>.Parser (~ (poly.code *env* type))))))] + .let [@JSON\decoded (: (-> Type Code) + (function (_ type) + (` (</>.Parser (~ (poly.code *env* type))))))] inputT <type>.next] ($_ <>.either <basic> @@ -257,29 +258,29 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (in (` (: (~ (@JSON\decode inputT)) + (in (` (: (~ (@JSON\decoded inputT)) ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.applied ($_ <>.and (<type>.exactly dictionary.Dictionary) (<type>.exactly .Text) - decode))] - (in (` (: (~ (@JSON\decode inputT)) + decoded))] + (in (` (: (~ (@JSON\decoded inputT)) ((~! </>.dictionary) (~ valC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) - decode))] - (in (` (: (~ (@JSON\decode inputT)) + decoded))] + (in (` (: (~ (@JSON\decoded inputT)) ((~! </>.nullable) (~ subC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) - decode))] - (in (` (: (~ (@JSON\decode inputT)) + decoded))] + (in (` (: (~ (@JSON\decoded inputT)) ((~! </>.array) ((~! <>.some) (~ subC))))))) (do ! - [members (<type>.variant (<>.many decode)) + [members (<type>.variant (<>.many decoded)) .let [last (-- (list.size members))]] - (in (` (: (~ (@JSON\decode inputT)) + (in (` (: (~ (@JSON\decoded inputT)) ($_ ((~! <>.or)) (~+ (list\map (function (_ [tag memberC]) (if (n.= last tag) @@ -293,24 +294,24 @@ ((~! </>.array)))))) (list.enumeration members)))))))) (do ! - [g!decoders (<type>.tuple (<>.many decode))] - (in (` (: (~ (@JSON\decode inputT)) + [g!decoders (<type>.tuple (<>.many decoded))] + (in (` (: (~ (@JSON\decoded inputT)) ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) ... Type recursion (do ! - [[selfC bodyC] (<type>.recursive decode) + [[selfC bodyC] (<type>.recursive decoded) .let [g! (code.local_identifier "____________")]] - (in (` (: (~ (@JSON\decode inputT)) + (in (` (: (~ (@JSON\decoded inputT)) ((~! <>.rec) (.function ((~ g!) (~ selfC)) (~ bodyC))))))) <type>.recursive_self ... Type applications (do ! - [[funcC argsC] (<type>.applied (<>.and decode (<>.many decode)))] + [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))] (in (` ((~ funcC) (~+ argsC))))) ... Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic decode)] + [[funcC varsC bodyC] (<type>.polymorphic decoded)] (in (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC))))) @@ -343,8 +344,8 @@ (..codec Record)))} (in (.list (` (: (codec.Codec /.JSON (~ inputT)) (implementation - (def: (~' encode) - ((~! ..encode) (~ inputT))) - (def: (~' decode) - ((~! </>.result) ((~! ..decode) (~ inputT)))) + (def: (~' encoded) + ((~! ..encoded) (~ inputT))) + (def: (~' decoded) + ((~! </>.result) ((~! ..decoded) (~ inputT)))) )))))) |