From dd505e9d5c528388e80ca5a2cd3d08c8001ed634 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 5 Sep 2017 18:38:26 -0400 Subject: - Added polytypic JSON codec support for unit-types. --- stdlib/test/test/lux/data/format/json.lux | 95 +++++++++++++++++++------------ stdlib/test/test/lux/time/date.lux | 2 +- stdlib/test/test/lux/time/duration.lux | 3 +- stdlib/test/test/lux/time/instant.lux | 9 +-- 4 files changed, 66 insertions(+), 43 deletions(-) (limited to 'stdlib/test') 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 map (unit;in carrier)))) + (def: gen-record (r;Random Record) (do r;Monad [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 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 size (r;text size) r;frac) + ## gen-recursive + _instant;instant + _duration;duration + _date;date + (qty unit;@Gram) ))) (derived: (poly/json;Codec Record)) @@ -111,28 +132,32 @@ (case [left right] [(#Case0 left') (#Case0 right')] (:: bool;Eq = left' right') - + [(#Case1 left') (#Case1 right')] (:: text;Eq = left' right') - + [(#Case2 left') (#Case2 right')] (f.= left' right') _ false))] - (and (:: bool;Eq = (get@ #bool recL) (get@ #bool recR)) - (f.= (get@ #frac recL) (get@ #frac recR)) - (:: text;Eq = (get@ #text recL) (get@ #text recR)) - (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list;Eq number;Eq) = (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 = tL0 tR0) - (f.= tL1 tR1) - (:: text;Eq = tL2 tR2))) - (:: (d;Eq number;Eq) = (get@ #dict recL) (get@ #dict recR)) - (:: Eq = (get@ #recursive recL) (get@ #recursive recR)) + (and ## (:: bool;Eq = (get@ #bool recL) (get@ #bool recR)) + ## (f.= (get@ #frac recL) (get@ #frac recR)) + ## (:: text;Eq = (get@ #text recL) (get@ #text recR)) + ## (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR)) + ## (:: (list;Eq number;Eq) = (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 = tL0 tR0) + ## (f.= tL1 tR1) + ## (:: text;Eq = tL2 tR2))) + ## (:: (d;Eq number;Eq) = (get@ #dict recL) (get@ #dict recR)) + ## (:: Eq = (get@ #recursive recL) (get@ #recursive recR)) + (:: ti;Eq = (get@ #instant recL) (get@ #instant recR)) + (:: tdu;Eq = (get@ #duration recL) (get@ #duration recR)) + (:: tda;Eq = (get@ #date recL) (get@ #date recR)) + (:: unit;Eq = (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 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 map @;from-millis))) @@ -59,6 +59,7 @@ )) (context: "Codec" + #seed +9664448049824422386 [sample duration #let [(^open "@/") @;Eq (^open "@/") @;Codec]] 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 map (|>. (i.% boundary) @;from-millis)))) -(def: duration - (r;Random @d;Duration) - (|> r;int (:: r;Monad 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 (^open "@d/") @d;Eq]] ($_ seq -- cgit v1.2.3