diff options
Diffstat (limited to 'stdlib/source/test/lux/data/format/json.lux')
| -rw-r--r-- | stdlib/source/test/lux/data/format/json.lux | 145 |
1 files changed, 47 insertions, 98 deletions
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index cdaeb5d31..11bed07da 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -1,20 +1,24 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control - [monad (#+ do Monad)] + pipe codec + [monad (#+ do Monad)] [equivalence (#+ Equivalence)] - pipe - ["p" parser]] + ["p" parser] + {[0 #test] + [/ + ["$." equivalence] + ["$." codec]]}] [data ["." error] ["." bit] ["." maybe] - ["." number] - ["." text - format] - [format - ["@" json]] + ["." text] + [number + ["." frac]] [collection [row (#+ row)] ["d" dictionary] @@ -26,58 +30,40 @@ [type ["." unit]] [math - ["r" random]] + ["r" random (#+ Random)]] [time ["ti" instant] ["tda" date] ## ["tdu" duration] - ] - test] + ]] [test [lux [time ["_." instant] ## ["_." duration] ["_." date]]]] + {1 + ["." / (#+ JSON)]} ) -(def: gen-json - (r.Random @.JSON) - (r.rec (function (_ gen-json) +(def: #export json + (Random JSON) + (r.rec (function (_ json) (do r.monad [size (:: @ map (n/% 2) r.nat)] ($_ r.or (:: @ wrap []) r.bit - (|> r.frac (:: @ map (f/* +1,000,000.0))) + r.frac (r.unicode size) - (r.row size gen-json) - (r.dictionary text.hash size (r.unicode size) gen-json) + (r.row size json) + (r.dictionary text.hash size (r.unicode size) json) ))))) -(context: "JSON" - (<| (times 100) - (do @ - [sample gen-json - #let [(^open "@/.") @.equivalence - (^open "@/.") @.codec]] - ($_ seq - (test "Every JSON is equal to itself." - (@/= sample sample)) - - (test "Can encode/decode JSON." - (|> sample @/encode @/decode - (case> (#.Right result) - (@/= sample result) - - (#.Left _) - #0))) - )))) - (type: Variant - (#Case0 Bit) - (#Case1 Text) - (#Case2 Frac)) + (#Bit Bit) + (#Text Text) + (#Frac Frac)) (type: #rec Recursive (#Number Frac) @@ -89,9 +75,9 @@ #text Text #maybe (Maybe Frac) #list (List Frac) - #dict (d.Dictionary Text Frac) - ## #variant Variant - ## #tuple [Bit Frac Text] + #dictionary (d.Dictionary Text Frac) + #variant Variant + #tuple [Bit Frac Text] #recursive Recursive ## #instant ti.Instant ## #duration tdu.Duration @@ -100,19 +86,19 @@ }) (def: gen-recursive - (r.Random Recursive) + (Random Recursive) (r.rec (function (_ gen-recursive) (r.or r.frac (r.and r.frac gen-recursive))))) -(derived: (poly/equivalence.Equivalence<?> Recursive)) +(derived: recursive-equivalence (poly/equivalence.equivalence Recursive)) (def: qty - (All [unit] (r.Random (unit.Qty unit))) + (All [unit] (Random (unit.Qty unit))) (|> r.int (:: r.monad map unit.in))) (def: gen-record - (r.Random Record) + (Random Record) (do r.monad [size (:: @ map (n/% 2) r.nat)] ($_ r.and @@ -122,8 +108,8 @@ (r.maybe r.frac) (r.list size r.frac) (r.dictionary text.hash size (r.unicode size) r.frac) - ## ($_ r.or r.bit (r.unicode size) r.frac) - ## ($_ r.and r.bit r.frac (r.unicode size)) + ($_ r.or r.bit (r.unicode size) r.frac) + ($_ r.and r.bit r.frac (r.unicode size)) gen-recursive ## _instant.instant ## _duration.duration @@ -131,53 +117,16 @@ qty ))) -(derived: (poly/json.codec Record)) - -(structure: _ (Equivalence Record) - (def: (= recL recR) - (let [variant/= (function (_ left right) - (case [left right] - [(#Case0 left') (#Case0 right')] - (:: bit.equivalence = left' right') - - [(#Case1 left') (#Case1 right')] - (:: text.equivalence = left' right') - - [(#Case2 left') (#Case2 right')] - (f/= left' right') - - _ - #0))] - (and (:: bit.equivalence = (get@ #bit recL) (get@ #bit recR)) - (f/= (get@ #frac recL) (get@ #frac recR)) - (:: text.equivalence = (get@ #text recL) (get@ #text recR)) - (:: (maybe.equivalence number.equivalence) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list.equivalence number.equivalence) = (get@ #list recL) (get@ #list recR)) - (:: (d.equivalence number.equivalence) = (get@ #dict recL) (get@ #dict recR)) - ## (variant/= (get@ #variant recL) (get@ #variant recR)) - ## (let [[tL0 tL1 tL2] (get@ #tuple recL) - ## [tR0 tR1 tR2] (get@ #tuple recR)] - ## (and (:: bit.equivalence = tL0 tR0) - ## (f/= tL1 tR1) - ## (:: text.equivalence = tL2 tR2))) - (:: equivalence = (get@ #recursive recL) (get@ #recursive recR)) - ## (:: ti.equivalence = (get@ #instant recL) (get@ #instant recR)) - ## (:: tdu.equivalence = (get@ #duration recL) (get@ #duration recR)) - (:: tda.equivalence = (get@ #date recL) (get@ #date recR)) - (:: unit.equivalence = (get@ #grams recL) (get@ #grams recR)) - )))) - -(context: "Polytypism" - (<| (seed 14562075782602945288) - ## (times 100) - (do @ - [sample gen-record - #let [(^open "@/.") ..equivalence - (^open "@/.") ..codec]] - (test "Can encode/decode arbitrary types." - (|> sample @/encode @/decode - (case> (#error.Success result) - (@/= sample result) - - (#error.Failure error) - #0)))))) +(derived: equivalence (poly/equivalence.equivalence Record)) +(derived: codec (poly/json.codec Record)) + +(def: #export test + Test + (<| (_.context (%name (name-of /.JSON))) + ($_ _.and + ($equivalence.spec /.equivalence ..json) + ($codec.spec /.equivalence /.codec ..json) + (<| (_.context "Polytypism.") + (<| (_.seed 14562075782602945288) + ($codec.spec ..equivalence ..codec gen-record))) + ))) |