aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/macro/poly/json.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-11-29 04:51:04 -0400
committerEduardo Julian2017-11-29 04:51:04 -0400
commit8c5cca122817bc63f4f84cc8351ced3cb67e5eea (patch)
tree8803dd3ed59ddcc6b964354fd312ab9e62e12cd8 /stdlib/source/lux/macro/poly/json.lux
parent1ef969c8ce0f1a83ffa8d26d779806190ac3eced (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.lux250
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))))
)))))))