diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/poly/lux/abstract/equivalence.lux | 34 | ||||
| -rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 162 |
2 files changed, 98 insertions, 98 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index a4d139aa4..0f5db0309 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -11,14 +11,14 @@ ["." bit] ["." maybe] [number - ["." nat ("#//." decimal)] + ["." nat ("#\." decimal)] ["." int] ["." rev] ["." frac]] - ["." text ("#//." monoid) + ["." text ("#\." monoid) ["%" format (#+ format)]] [collection - ["." list ("#//." monad)] + ["." list ("#\." monad)] ["." row] ["." array] ["." queue] @@ -115,15 +115,15 @@ (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) (~ g!left) (~ g!right)) (case [(~ g!left) (~ g!right)] - (~+ (list//join (list//map (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) - ((~ (code.nat (dec tag))) #1 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [((~ (code.nat tag)) #0 (~ g!left)) - ((~ (code.nat tag)) #0 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) + (~+ (list\join (list\map (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) + ((~ (code.nat (dec tag))) #1 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [((~ (code.nat tag)) #0 (~ g!left)) + ((~ (code.nat tag)) #0 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) + (list.enumeration members)))) (~ g!_) #0)))))) ## Tuples @@ -131,13 +131,13 @@ [g!eqs (<type>.tuple (p.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\encode (text\compose "left") code.local-identifier) indices) + g!rights (list\map (|>> nat\encode (text\compose "right") code.local-identifier) indices)]] (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) (and (~+ (|> (list.zip/3 g!eqs g!lefts g!rights) - (list//map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + (list\map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) @@ -156,7 +156,7 @@ (do ! [[funcC varsC bodyC] (<type>.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list//map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) ((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index afe34c404..15c8c5906 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -18,14 +18,14 @@ ["." product] [number ["." i64] - ["n" nat ("#//." decimal)] + ["n" nat ("#\." decimal)] ["." int] - ["." frac ("#//." decimal)]] - ["." text ("#//." equivalence) + ["." frac ("#\." decimal)]] + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#//." fold monad)] - ["." row (#+ Row row) ("#//." monad)] + ["." list ("#\." fold monad)] + ["." row (#+ Row row) ("#\." monad)] ["d" dictionary]]] [time ## ["." instant] @@ -96,13 +96,13 @@ (def: decode (|>> (:: ..int-codec decode) (:: e.functor map unit.in)))) -(poly: #export codec//encode +(poly: #export codec\encode (with-expansions [<basic> (template [<matcher> <encoder>] [(do ! [#let [g!_ (code.local-identifier "_______")] _ <matcher>] - (wrap (` (: (~ (@JSON//encode inputT)) + (wrap (` (: (~ (@JSON\encode inputT)) <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] @@ -114,7 +114,7 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON//encode inputT)) + (wrap (` (: (~ (@JSON\encode inputT)) (|>> (:: (~! <codec>) (~' encode)) #/.String)))))] ## [duration.Duration duration.codec] @@ -124,9 +124,9 @@ [month.Month month.codec])] (do {! p.monad} [*env* <type>.env - #let [@JSON//encode (: (-> Type Code) - (function (_ type) - (` (-> (~ (poly.to-code *env* type)) /.JSON))))] + #let [@JSON\encode (: (-> Type Code) + (function (_ type) + (` (-> (~ (poly.to-code *env* type)) /.JSON))))] inputT <type>.peek] ($_ p.either <basic> @@ -134,7 +134,7 @@ (do ! [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON//encode inputT)) + (wrap (` (: (~ (@JSON\encode inputT)) (:: (~! qty-codec) (~' encode)))))) (do ! [#let [g!_ (code.local-identifier "_______") @@ -143,73 +143,73 @@ [_ _ =val=] (<type>.apply ($_ p.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) - codec//encode))] - (wrap (` (: (~ (@JSON//encode inputT)) + codec\encode))] + (wrap (` (: (~ (@JSON\encode inputT)) (|>> ((~! d.entries)) - ((~! list//map) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) ((~! d.from-list) (~! text.hash)) #/.Object))))) (do ! [[_ =sub=] (<type>.apply ($_ p.and (<type>.exactly .Maybe) - codec//encode))] - (wrap (` (: (~ (@JSON//encode inputT)) + codec\encode))] + (wrap (` (: (~ (@JSON\encode inputT)) ((~! ..nullable) (~ =sub=)))))) (do ! [[_ =sub=] (<type>.apply ($_ p.and (<type>.exactly .List) - codec//encode))] - (wrap (` (: (~ (@JSON//encode inputT)) - (|>> ((~! list//map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) + codec\encode))] + (wrap (` (: (~ (@JSON\encode inputT)) + (|>> ((~! list\map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) (do ! [#let [g!_ (code.local-identifier "_______") g!input (code.local-identifier "_______input")] - members (<type>.variant (p.many codec//encode)) + members (<type>.variant (p.many codec\encode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON//encode inputT)) + (wrap (` (: (~ (@JSON\encode inputT)) (function ((~ g!_) (~ g!input)) (case (~ g!input) - (~+ (list//join (list//map (function (_ [tag g!encode]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) - #1 - ((~ g!encode) (~ g!input))]))) - (list (` ((~ (code.nat tag)) #0 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encode) (~ g!input))]))))) - (list.enumeration members)))))))))) + (~+ (list\join (list\map (function (_ [tag g!encode]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) + #1 + ((~ g!encode) (~ g!input))]))) + (list (` ((~ (code.nat tag)) #0 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encode) (~ g!input))]))))) + (list.enumeration members)))))))))) (do ! - [g!encoders (<type>.tuple (p.many codec//encode)) + [g!encoders (<type>.tuple (p.many codec\encode)) #let [g!_ (code.local-identifier "_______") g!members (|> (list.size g!encoders) list.indices - (list//map (|>> n//encode code.local-identifier)))]] - (wrap (` (: (~ (@JSON//encode inputT)) + (list\map (|>> n\encode code.local-identifier)))]] + (wrap (` (: (~ (@JSON\encode inputT)) (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list//map (function (_ [g!member g!encode]) - (` ((~ g!encode) (~ g!member)))) - (list.zip/2 g!members g!encoders)))])))))) + ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) + (` ((~ g!encode) (~ g!member)))) + (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! - [[selfC non-recC] (<type>.recursive codec//encode) + [[selfC non-recC] (<type>.recursive codec\encode) #let [g! (code.local-identifier "____________")]] - (wrap (` (: (~ (@JSON//encode inputT)) + (wrap (` (: (~ (@JSON\encode inputT)) ((~! ..rec-encode) (.function ((~ g!) (~ selfC)) (~ non-recC))))))) <type>.recursive-self ## Type applications (do ! - [partsC (<type>.apply (p.many codec//encode))] + [partsC (<type>.apply (p.many codec\encode))] (wrap (` ((~+ partsC))))) ## Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic codec//encode)] + [[funcC varsC bodyC] (<type>.polymorphic codec\encode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list//map (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) + (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) (-> ((~ (poly.to-code *env* inputT)) (~+ varsC)) /.JSON))) (function ((~ funcC) (~+ varsC)) @@ -220,12 +220,12 @@ (p.fail (format "Cannot create JSON encoder for: " (type.format inputT))) )))) -(poly: #export codec//decode +(poly: #export codec\decode (with-expansions [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] - (wrap (` (: (~ (@JSON//decode inputT)) + (wrap (` (: (~ (@JSON\decode inputT)) (~! <decoder>)))))] [(<type>.exactly Any) </>.null] @@ -237,7 +237,7 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON//decode inputT)) + (wrap (` (: (~ (@JSON\decode inputT)) ((~! p.codec) (~! <codec>) (~! </>.string))))))] ## [duration.Duration duration.codec] @@ -247,9 +247,9 @@ [month.Month month.codec])] (do {! p.monad} [*env* <type>.env - #let [@JSON//decode (: (-> Type Code) - (function (_ type) - (` (</>.Parser (~ (poly.to-code *env* type))))))] + #let [@JSON\decode (: (-> Type Code) + (function (_ type) + (` (</>.Parser (~ (poly.to-code *env* type))))))] inputT <type>.peek] ($_ p.either <basic> @@ -257,62 +257,62 @@ (do ! [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON//decode inputT)) + (wrap (` (: (~ (@JSON\decode inputT)) ((~! p.codec) (~! qty-codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.apply ($_ p.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) - codec//decode))] - (wrap (` (: (~ (@JSON//decode inputT)) + codec\decode))] + (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.dictionary) (~ valC)))))) (do ! [[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe) - codec//decode))] - (wrap (` (: (~ (@JSON//decode inputT)) + codec\decode))] + (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.nullable) (~ subC)))))) (do ! [[_ subC] (<type>.apply (p.and (<type>.exactly .List) - codec//decode))] - (wrap (` (: (~ (@JSON//decode inputT)) + codec\decode))] + (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.array) ((~! p.some) (~ subC))))))) (do ! - [members (<type>.variant (p.many codec//decode)) + [members (<type>.variant (p.many codec\decode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON//decode inputT)) + (wrap (` (: (~ (@JSON\decode inputT)) ($_ ((~! p.or)) - (~+ (list//map (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) + (~+ (list\map (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) (do ! - [g!decoders (<type>.tuple (p.many codec//decode))] - (wrap (` (: (~ (@JSON//decode inputT)) + [g!decoders (<type>.tuple (p.many codec\decode))] + (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders))))))) ## Type recursion (do ! - [[selfC bodyC] (<type>.recursive codec//decode) + [[selfC bodyC] (<type>.recursive codec\decode) #let [g! (code.local-identifier "____________")]] - (wrap (` (: (~ (@JSON//decode inputT)) + (wrap (` (: (~ (@JSON\decode inputT)) ((~! p.rec) (.function ((~ g!) (~ selfC)) (~ bodyC))))))) <type>.recursive-self ## Type applications (do ! - [[funcC argsC] (<type>.apply (p.and codec//decode (p.many codec//decode)))] + [[funcC argsC] (<type>.apply (p.and codec\decode (p.many codec\decode)))] (wrap (` ((~ funcC) (~+ argsC))))) ## Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic codec//decode)] + [[funcC varsC bodyC] (<type>.polymorphic codec\decode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list//map (|>> (~) </>.Parser (`)) varsC)) + (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) (</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) @@ -342,7 +342,7 @@ (derived: (..codec Record)))} (wrap (list (` (: (codec.Codec /.JSON (~ inputT)) (structure (def: (~' encode) - (..codec//encode (~ inputT))) + (..codec\encode (~ inputT))) (def: (~' decode) - ((~! </>.run) (..codec//decode (~ inputT)))) + ((~! </>.run) (..codec\decode (~ inputT)))) )))))) |