diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/control/codec.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/format/json.lux | 145 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/format/xml.lux | 169 |
4 files changed, 140 insertions, 191 deletions
diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux index e061f9e36..f8159838b 100644 --- a/stdlib/source/test/lux/control/codec.lux +++ b/stdlib/source/test/lux/control/codec.lux @@ -18,7 +18,7 @@ (do r.monad [expected generator] (<| (_.context (%name (name-of /.Codec))) - (_.test "Reflexivity." + (_.test "Isomorphism." (case (|> expected /@encode /@decode) (#error.Success actual) (/@= expected actual) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 907082d99..9175d970e 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -22,9 +22,11 @@ ["#." text ["#/." lexer] ["#/." regex]] - ]) + [format + ["#." json] + ["#." xml]]]) -(def: #export number +(def: number Test ($_ _.and /i64.test @@ -36,13 +38,19 @@ /complex.test )) -(def: #export text +(def: text ($_ _.and /text.test /text/lexer.test /text/regex.test )) +(def: format + ($_ _.and + /json.test + /xml.test + )) + (def: #export test Test ($_ _.and @@ -57,4 +65,5 @@ /sum.test ..number ..text + ..format )) 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))) + ))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 35e7dc4a1..221edba97 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -1,23 +1,27 @@ (.module: - [lux #* + [lux (#- char) + data/text/format + ["_" test (#+ Test)] [control + pipe [monad (#+ Monad do)] ["p" parser] - pipe] + {[0 #test] + [/ + ["$." equivalence] + ["$." codec]]}] [data ["." name] ["E" error] ["." maybe] - ["." text ("#;." equivalence) - format] - [format - ["&" xml]] + ["." text ("#@." equivalence)] [collection - ["dict" dictionary] - ["." list ("#;." functor)]]] + ["." dictionary] + ["." list ("#@." functor)]]] [math - ["r" random ("#;." monad)]]] - lux/test) + ["r" random (#+ Random) ("#@." monad)]]] + {1 + ["." / (#+ XML)]}) (def: char-range Text @@ -25,97 +29,84 @@ "abcdefghijklmnopqrstuvwxyz" "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) -(def: xml-char^ - (r.Random Nat) +(def: char + (Random Nat) (do r.monad [idx (|> r.nat (:: @ map (n/% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) -(def: (size^ bottom top) - (-> Nat Nat (r.Random Nat)) +(def: (size bottom top) + (-> Nat Nat (Random Nat)) (let [constraint (|>> (n/% top) (n/max bottom))] - (r;map constraint r.nat))) + (r@map constraint r.nat))) -(def: (xml-text^ bottom top) - (-> Nat Nat (r.Random Text)) +(def: (text bottom top) + (-> Nat Nat (Random Text)) (do r.monad - [size (size^ bottom top)] - (r.text xml-char^ size))) + [size (..size bottom top)] + (r.text ..char size))) (def: xml-identifier^ - (r.Random Name) - (r.and (xml-text^ 0 10) - (xml-text^ 1 10))) + (Random Name) + (r.and (..text 0 10) + (..text 1 10))) -(def: gen-xml - (r.Random &.XML) - (r.rec (function (_ gen-xml) - (r.or (xml-text^ 1 10) +(def: #export xml + (Random XML) + (r.rec (function (_ xml) + (r.or (..text 1 10) (do r.monad - [size (size^ 0 2)] + [size (..size 0 2)] ($_ r.and xml-identifier^ - (r.dictionary name.hash size xml-identifier^ (xml-text^ 0 10)) - (r.list size gen-xml))))))) + (r.dictionary name.hash size xml-identifier^ (..text 0 10)) + (r.list size xml))))))) -(context: "XML." - (<| (times 100) - (do @ - [sample gen-xml - #let [(^open "&;.") &.equivalence - (^open "&;.") &.codec]] - ($_ seq - (test "Every XML is equal to itself." - (&;= sample sample)) +(def: #export test + Test + (<| (_.context (%name (name-of /.XML))) + ($_ _.and + ($equivalence.spec /.equivalence ..xml) + ($codec.spec /.equivalence /.codec ..xml) - (test "Can encode/decode XML." - (|> sample &;encode &;decode - (case> (#.Right result) - (&;= sample result) - - (#.Left error) - #0))) - )))) - -(context: "Parsing." - (<| (times 100) - (do @ - [text (xml-text^ 1 10) - num-children (|> r.nat (:: @ map (n/% 5))) - children (r.list num-children (xml-text^ 1 10)) - tag xml-identifier^ - attr xml-identifier^ - value (xml-text^ 1 10) - #let [node (#&.Node tag - (dict.put attr value &.attrs) - (list;map (|>> #&.Text) children))]] - ($_ seq - (test "Can parse text." - (E.default #0 - (do E.monad - [output (&.run (#&.Text text) - &.text)] - (wrap (text;= text output))))) - (test "Can parse attributes." - (E.default #0 - (do E.monad - [output (|> (&.attr attr) - (p.before &.ignore) - (&.run node))] - (wrap (text;= value output))))) - (test "Can parse nodes." - (E.default #0 - (do E.monad - [_ (|> (&.node tag) - (p.before &.ignore) - (&.run node))] - (wrap #1)))) - (test "Can parse children." - (E.default #0 - (do E.monad - [outputs (|> (&.children (p.some &.text)) - (&.run node))] - (wrap (:: (list.equivalence text.equivalence) = - children - outputs))))) - )))) + (do r.monad + [text (..text 1 10) + num-children (|> r.nat (:: @ map (n/% 5))) + children (r.list num-children (..text 1 10)) + tag xml-identifier^ + attr xml-identifier^ + value (..text 1 10) + #let [node (#/.Node tag + (dictionary.put attr value /.attrs) + (list@map (|>> #/.Text) children))]] + ($_ _.and + (_.test "Can parse text." + (E.default #0 + (do E.monad + [output (/.run (#/.Text text) + /.text)] + (wrap (text@= text output))))) + (_.test "Can parse attributes." + (E.default #0 + (do E.monad + [output (|> (/.attr attr) + (p.before /.ignore) + (/.run node))] + (wrap (text@= value output))))) + (_.test "Can parse nodes." + (E.default #0 + (do E.monad + [_ (|> (/.node tag) + (p.before /.ignore) + (/.run node))] + (wrap #1)))) + (_.test "Can parse children." + (E.default #0 + (do E.monad + [outputs (|> (/.children (p.some /.text)) + (/.run node))] + (wrap (:: (list.equivalence text.equivalence) = + children + outputs))))) + )) + ))) |