aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/macro/poly/json.lux22
-rw-r--r--stdlib/test/test/lux/data/format/json.lux95
-rw-r--r--stdlib/test/test/lux/time/date.lux2
-rw-r--r--stdlib/test/test/lux/time/duration.lux3
-rw-r--r--stdlib/test/test/lux/time/instant.lux9
5 files changed, 86 insertions, 45 deletions
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 2c87603d3..379be9f49 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -27,6 +27,7 @@
[code]
[poly #+ poly:])
[type]
+ (type [unit])
))
(def: #hidden _map_
@@ -49,7 +50,7 @@
(struct: #hidden _ (Codec JSON Nat)
(def: (encode input)
- (let [high (|> input (bit;and high-mask) (bit;unsigned-shift-right +32))
+ (let [high (|> input (bit;and high-mask) (bit;shift-right +32))
low (bit;and low-mask input)]
(#..;Array (vector (|> high nat-to-int int-to-frac #..;Number)
(|> low nat-to-int int-to-frac #..;Number)))))
@@ -74,6 +75,13 @@
#;None #..;Null
(#;Some value) (writer value))))
+(struct: #hidden (Codec<JSON,Qty> carrier)
+ (All [unit] (-> unit (Codec JSON (unit;Qty unit))))
+ (def: encode
+ (|>. unit;out (:: Codec<JSON,Int> encode)))
+ (def: decode
+ (|>. (:: Codec<JSON,Int> decode) (:: R;Functor<Result> map (unit;in carrier)))))
+
(poly: #hidden Codec<JSON,?>//encode
(with-expansions
[<basic> (do-template [<type> <matcher> <encoder>]
@@ -92,7 +100,7 @@
[(do @
[_ (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>]
@@ -109,6 +117,11 @@
<basic>
<time>
(do @
+ [unitT (poly;apply (p;after (poly;this unit;Qty)
+ poly;any))]
+ (wrap (` (: (~ (@JSON//encode inputT))
+ (:: (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
@@ -216,6 +229,11 @@
<basic>
<time>
(do @
+ [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)))))
+ (do @
[[_ _ valC] (poly;apply ($_ p;seq
(poly;this d;Dict)
poly;text
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index bd0e4ab67..2eca6febd 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -23,7 +23,14 @@
[poly/eq]
[poly/json])
["r" math/random]
+ (time ["ti" instant]
+ ["tda" date]
+ ["tdu" duration])
+ (type [unit])
test)
+ (test (lux (time ["_;" instant]
+ ["_;" duration]
+ ["_;" date])))
)
(def: gen-json
@@ -67,16 +74,21 @@
(#Addition Frac Recursive))
(type: Record
- {#unit Unit
- #bool Bool
- #frac Frac
- #text Text
- #maybe (Maybe Frac)
- #list (List Frac)
- #variant Variant
- #tuple [Bool Frac Text]
- #dict (d;Dict Text Frac)
- #recursive Recursive})
+ {## #unit Unit
+ ## #bool Bool
+ ## #frac Frac
+ ## #text Text
+ ## #maybe (Maybe Frac)
+ ## #list (List Frac)
+ ## #variant Variant
+ ## #tuple [Bool Frac Text]
+ ## #dict (d;Dict Text Frac)
+ ## #recursive Recursive
+ #instant ti;Instant
+ #duration tdu;Duration
+ #date tda;Date
+ #grams (unit;Qty unit;Gram)
+ })
(def: gen-recursive
(r;Random Recursive)
@@ -86,21 +98,30 @@
(derived: (poly/eq;Eq<?> Recursive))
+(def: (qty carrier)
+ (All [unit] (-> unit (r;Random (unit;Qty unit))))
+ (|> r;int
+ (:: r;Monad<Random> map (unit;in carrier))))
+
(def: gen-record
(r;Random Record)
(do r;Monad<Random>
[size (:: @ map (n.% +2) r;nat)]
($_ r;seq
- (:: @ wrap [])
- r;bool
- r;frac
- (r;text size)
- (r;maybe r;frac)
- (r;list size r;frac)
- ($_ r;alt r;bool (r;text size) r;frac)
- ($_ r;seq r;bool r;frac (r;text size))
- (r;dict text;Hash<Text> size (r;text size) r;frac)
- gen-recursive
+ ## (:: @ wrap [])
+ ## r;bool
+ ## r;frac
+ ## (r;text size)
+ ## (r;maybe r;frac)
+ ## (r;list size r;frac)
+ ## ($_ r;alt r;bool (r;text size) r;frac)
+ ## ($_ r;seq r;bool r;frac (r;text size))
+ ## (r;dict text;Hash<Text> size (r;text size) r;frac)
+ ## gen-recursive
+ _instant;instant
+ _duration;duration
+ _date;date
+ (qty unit;@Gram)
)))
(derived: (poly/json;Codec<JSON,?> Record))
@@ -111,28 +132,32 @@
(case [left right]
[(#Case0 left') (#Case0 right')]
(:: bool;Eq<Bool> = left' right')
-
+
[(#Case1 left') (#Case1 right')]
(:: text;Eq<Text> = left' right')
-
+
[(#Case2 left') (#Case2 right')]
(f.= left' right')
_
false))]
- (and (:: bool;Eq<Bool> = (get@ #bool recL) (get@ #bool recR))
- (f.= (get@ #frac recL) (get@ #frac recR))
- (:: text;Eq<Text> = (get@ #text recL) (get@ #text recR))
- (:: (maybe;Eq<Maybe> number;Eq<Frac>) = (get@ #maybe recL) (get@ #maybe recR))
- (:: (list;Eq<List> number;Eq<Frac>) = (get@ #list recL) (get@ #list recR))
- (variant/= (get@ #variant recL) (get@ #variant recR))
- (let [[tL0 tL1 tL2] (get@ #tuple recL)
- [tR0 tR1 tR2] (get@ #tuple recR)]
- (and (:: bool;Eq<Bool> = tL0 tR0)
- (f.= tL1 tR1)
- (:: text;Eq<Text> = tL2 tR2)))
- (:: (d;Eq<Dict> number;Eq<Frac>) = (get@ #dict recL) (get@ #dict recR))
- (:: Eq<Recursive> = (get@ #recursive recL) (get@ #recursive recR))
+ (and ## (:: bool;Eq<Bool> = (get@ #bool recL) (get@ #bool recR))
+ ## (f.= (get@ #frac recL) (get@ #frac recR))
+ ## (:: text;Eq<Text> = (get@ #text recL) (get@ #text recR))
+ ## (:: (maybe;Eq<Maybe> number;Eq<Frac>) = (get@ #maybe recL) (get@ #maybe recR))
+ ## (:: (list;Eq<List> number;Eq<Frac>) = (get@ #list recL) (get@ #list recR))
+ ## (variant/= (get@ #variant recL) (get@ #variant recR))
+ ## (let [[tL0 tL1 tL2] (get@ #tuple recL)
+ ## [tR0 tR1 tR2] (get@ #tuple recR)]
+ ## (and (:: bool;Eq<Bool> = tL0 tR0)
+ ## (f.= tL1 tR1)
+ ## (:: text;Eq<Text> = tL2 tR2)))
+ ## (:: (d;Eq<Dict> number;Eq<Frac>) = (get@ #dict recL) (get@ #dict recR))
+ ## (:: Eq<Recursive> = (get@ #recursive recL) (get@ #recursive recR))
+ (:: ti;Eq<Instant> = (get@ #instant recL) (get@ #instant recR))
+ (:: tdu;Eq<Duration> = (get@ #duration recL) (get@ #duration recR))
+ (:: tda;Eq<Date> = (get@ #date recL) (get@ #date recR))
+ (:: unit;Eq<Unit> = (get@ #grams recL) (get@ #grams recR))
))))
(context: "Polytypism"
diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux
index 2a56fb71a..a73001026 100644
--- a/stdlib/test/test/lux/time/date.lux
+++ b/stdlib/test/test/lux/time/date.lux
@@ -89,7 +89,7 @@
(|> sample @/succ @/pred (@/= sample))
(|> sample @/pred @/succ (@/= sample)))))
-(def: date
+(def: #export date
(r;Random @;Date)
(|> _instant;instant (:: r;Monad<Random> map @instant;date)))
diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux
index 565010a07..020c198e6 100644
--- a/stdlib/test/test/lux/time/duration.lux
+++ b/stdlib/test/test/lux/time/duration.lux
@@ -8,7 +8,7 @@
(time ["@" duration]))
lux/test)
-(def: duration
+(def: #export duration
(r;Random @;Duration)
(|> r;int (:: r;Monad<Random> map @;from-millis)))
@@ -59,6 +59,7 @@
))
(context: "Codec"
+ #seed +9664448049824422386
[sample duration
#let [(^open "@/") @;Eq<Duration>
(^open "@/") @;Codec<Text,Duration>]]
diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux
index 2343beac1..c686de5b7 100644
--- a/stdlib/test/test/lux/time/instant.lux
+++ b/stdlib/test/test/lux/time/instant.lux
@@ -11,7 +11,8 @@
(time ["@" instant]
["@d" duration]
["@date" date]))
- lux/test)
+ lux/test
+ (.. ["_;" duration]))
(def: boundary Int 99_999_999_999_999)
@@ -19,10 +20,6 @@
(r;Random @;Instant)
(|> r;int (:: r;Monad<Random> map (|>. (i.% boundary) @;from-millis))))
-(def: duration
- (r;Random @d;Duration)
- (|> r;int (:: r;Monad<Random> map @d;from-millis)))
-
(context: "Conversion."
[millis r;int]
(test "Can convert from/to milliseconds."
@@ -57,7 +54,7 @@
(context: "Arithmetic"
[sample instant
- span duration
+ span _duration;duration
#let [(^open "@/") @;Eq<Instant>
(^open "@d/") @d;Eq<Duration>]]
($_ seq
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 10:28:41 +0000