diff options
author | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
commit | 8c5cca122817bc63f4f84cc8351ced3cb67e5eea (patch) | |
tree | 8803dd3ed59ddcc6b964354fd312ab9e62e12cd8 /stdlib/source/lux/macro/poly/json.lux | |
parent | 1ef969c8ce0f1a83ffa8d26d779806190ac3eced (diff) |
- Changed the identifier separator, from the semi-colon (;) to the period/dot (.).
Diffstat (limited to 'stdlib/source/lux/macro/poly/json.lux')
-rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 250 |
1 files changed, 125 insertions, 125 deletions
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index d001d4839..3a5148377 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Codecs for values in the JSON format."} +(.module: {#.doc "Codecs for values in the JSON format."} lux (lux (control [monad #+ do Monad] [eq #+ Eq] @@ -43,42 +43,42 @@ (function [input] (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit;shift-left +32) n/dec)) -(def: high-mask Nat (|> low-mask (bit;shift-left +32))) +(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) +(def: high-mask Nat (|> low-mask (bit.shift-left +32))) (struct: #hidden _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) - low (bit;and low-mask input)] - (#//;Array (sequence (|> high nat-to-int int-to-frac #//;Number) - (|> low nat-to-int int-to-frac #//;Number))))) + (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) + low (bit.and low-mask input)] + (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) + (|> low nat-to-int int-to-frac #//.Number))))) (def: (decode input) - (<| (//;run input) - (do p;Monad<Parser> - [high //;number - low //;number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit;shift-left +32)) + (<| (//.run input) + (do p.Monad<Parser> + [high //.number + low //.number]) + (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>> (:: Codec<JSON,Nat> decode) (:: e;Functor<Error> map nat-to-int)))) + (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) (def: #hidden (nullable writer) - {#;doc "Builds a JSON generator for potentially inexistent values."} + {#.doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] (case elem - #;None #//;Null - (#;Some value) (writer value)))) + #.None #//.Null + (#.Some value) (writer value)))) (struct: #hidden (Codec<JSON,Qty> carrier) - (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) + (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) (def: encode - (|>> unit;out (:: Codec<JSON,Int> encode))) + (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode - (|>> (:: Codec<JSON,Int> decode) (:: e;Functor<Error> map (unit;in carrier))))) + (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) (poly: #hidden Codec<JSON,?>//encode (with-expansions @@ -88,108 +88,108 @@ (wrap (` (: (~ (@JSON//encode inputT)) <encoder>))))] - [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #//;Null)] - [Bool poly;bool (|>> #//;Boolean)] - [Nat poly;nat (:: ;;Codec<JSON,Nat> (~' encode))] - [Int poly;int (:: ;;Codec<JSON,Int> (~' encode))] - [Frac poly;frac (|>> #//;Number)] - [Text poly;text (|>> #//;String)]) + [Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)] + [Bool poly.bool (|>> #//.Boolean)] + [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))] + [Int poly.int (:: ..Codec<JSON,Int> (~' encode))] + [Frac poly.frac (|>> #//.Number)] + [Text poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (:: <codec> (~' encode)) #//;String)))))] + (|>> (:: <codec> (~' encode)) #//.String)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//encode (: (-> Type Code) (function [type] - (` (-> (~ (poly;to-ast *env* type)) //;JSON))))] - inputT poly;peek] - ($_ p;either + (` (-> (~ (poly.to-ast *env* type)) //.JSON))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) (~' encode)))))) + (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) (do @ - [#let [g!key (code;local-symbol "\u0000key") - g!val (code;local-symbol "\u0000val")] - [_ _ .val.] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [#let [g!key (code.local-symbol "\u0000key") + g!val (code.local-symbol "\u0000val")] + [_ _ =val=] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> d;entries - (;;_map_ (function [[(~ g!key) (~ g!val)]] - [(~ g!key) ((~ .val.) (~ g!val))])) - (d;from-list text;Hash<Text>) - #//;Object))))) + (|>> d.entries + (.._map_ (function [[(~ g!key) (~ g!val)]] + [(~ g!key) ((~ =val=) (~ g!val))])) + (d.from-list text.Hash<Text>) + #//.Object))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;Maybe) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .Maybe) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (;;nullable (~ .sub.)))))) + (..nullable (~ =sub=)))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;List) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .List) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (;;_map_ (~ .sub.)) sequence;from-list #//;Array))))) + (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array))))) (do @ - [#let [g!input (code;local-symbol "\u0000input")] - members (poly;variant (p;many Codec<JSON,?>//encode))] + [#let [g!input (code.local-symbol "\u0000input")] + members (poly.variant (p.many Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (function [(~ g!input)] (case (~ g!input) (~@ (list/join (list/map (function [[tag g!encode]] - (list (` ((~ (code;nat tag)) (~ g!input))) - (` (//;json [(~ (code;frac (;;tag tag))) + (list (` ((~ (code.nat tag)) (~ g!input))) + (` (//.json [(~ (code.frac (..tag tag))) ((~ g!encode) (~ g!input))])))) - (list;enumerate members)))))))))) + (list.enumerate members)))))))))) (do @ - [g!encoders (poly;tuple (p;many Codec<JSON,?>//encode)) - #let [g!members (|> (list;size g!encoders) n/dec - (list;n/range +0) - (list/map (|>> nat/encode code;local-symbol)))]] + [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode)) + #let [g!members (|> (list.size g!encoders) n/dec + (list.n/range +0) + (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) (function [[(~@ g!members)]] - (//;json [(~@ (list/map (function [[g!member g!encode]] + (//.json [(~@ (list/map (function [[g!member g!encode]] (` ((~ g!encode) (~ g!member)))) - (list;zip2 g!members g!encoders)))])))))) + (list.zip2 g!members g!encoders)))])))))) ## Type recursion (do @ - [[selfC non-recC] (poly;recursive Codec<JSON,?>//encode)] + [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)] (wrap (` (: (~ (@JSON//encode inputT)) - (;;rec-encode (;function [(~ selfC)] + (..rec-encode (.function [(~ selfC)] (~ non-recC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [partsC (poly;apply (p;many Codec<JSON,?>//encode))] + [partsC (poly.apply (p.many Codec<JSON,?>//encode))] (wrap (` ((~@ partsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//encode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (function [varC] (` (-> (~ varC) //;JSON))) + (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON))) varsC)) - (-> ((~ (poly;to-ast *env* inputT)) (~@ varsC)) - //;JSON))) + (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC)) + //.JSON))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON encoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT))) )))) (poly: #hidden Codec<JSON,?>//decode @@ -200,94 +200,94 @@ (wrap (` (: (~ (@JSON//decode inputT)) <decoder>))))] - [Unit poly;unit //;null] - [Bool poly;bool //;boolean] - [Nat poly;nat (p;codec ;;Codec<JSON,Nat> //;any)] - [Int poly;int (p;codec ;;Codec<JSON,Int> //;any)] - [Frac poly;frac //;number] - [Text poly;text //;string]) + [Unit poly.unit //.null] + [Bool poly.bool //.boolean] + [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)] + [Int poly.int (p.codec ..Codec<JSON,Int> //.any)] + [Frac poly.frac //.number] + [Text poly.text //.string]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec <codec> //;string)))))] + (p.codec <codec> //.string)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//decode (: (-> Type Code) (function [type] - (` (//;Reader (~ (poly;to-ast *env* type))))))] - inputT poly;peek] - ($_ p;either + (` (//.Reader (~ (poly.to-ast *env* type))))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) //;any))))) + (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;object (~ valC)))))) + (//.object (~ valC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;Maybe) + [[_ subC] (poly.apply (p.seq (poly.this .Maybe) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;nullable (~ subC)))))) + (//.nullable (~ subC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;List) + [[_ subC] (poly.apply (p.seq (poly.this .List) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array (p;some (~ subC))))))) + (//.array (p.some (~ subC))))))) (do @ - [members (poly;variant (p;many Codec<JSON,?>//decode))] + [members (poly.variant (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - ($_ p;alt + ($_ p.alt (~@ (list/map (function [[tag memberC]] (` (|> (~ memberC) - (p;after (//;number! (~ (code;frac (;;tag tag))))) - //;array))) - (list;enumerate members)))))))) + (p.after (//.number! (~ (code.frac (..tag tag))))) + //.array))) + (list.enumerate members)))))))) (do @ - [g!decoders (poly;tuple (p;many Codec<JSON,?>//decode))] + [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array ($_ p;seq (~@ g!decoders))))))) + (//.array ($_ p.seq (~@ g!decoders))))))) ## Type recursion (do @ - [[selfC bodyC] (poly;recursive Codec<JSON,?>//decode)] + [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;rec (;function [(~ selfC)] + (p.rec (.function [(~ selfC)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Codec<JSON,?>//decode (p;many Codec<JSON,?>//decode)))] + [[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//decode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) //;Reader (`)) varsC)) - (//;Reader ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC)) + (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON decoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON decoder for: " (type.to-text inputT))) )))) (syntax: #export (Codec<JSON,?> inputT) - {#;doc (doc "A macro for automatically producing JSON codecs." + {#.doc (doc "A macro for automatically producing JSON codecs." (type: Variant (#Case0 Bool) (#Case1 Text) @@ -306,7 +306,7 @@ (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] - (wrap (list (` (: (Codec //;JSON (~ inputT)) + (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~ g!inputs)) (//;run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) ))))))) |