diff options
Diffstat (limited to '')
23 files changed, 479 insertions, 405 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index dec078509..c1aa9ae9b 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -13,6 +13,7 @@ ["#/." install]] ["#." local] ["#." dependency] + ["#." package] ["#." profile] ["#." project] ["#." cli] @@ -29,6 +30,7 @@ /command/install.test /local.test /dependency.test + /package.test /profile.test /project.test /cli.test diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index e65dd567a..c3da8465c 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -23,8 +23,8 @@ (_.with-cover [/.Extension] ($_ _.and (_.cover [/.lux-library /.jvm-library /.pom - /.sha1 /.md5] - (let [options (list /.lux-library /.jvm-library /.pom /.sha1 /.md5) + /.sha-1 /.md5] + (let [options (list /.lux-library /.jvm-library /.pom /.sha-1 /.md5) uniques (set.from-list text.hash options)] (n.= (list.size options) (set.size uniques)))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index cbc6f681b..0d8284d7c 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -21,9 +21,9 @@ (_.with-cover [/.Type] ($_ _.and (_.cover [/.lux-library /.jvm-library - /.pom /.md5 /.sha1] + /.pom /.md5 /.sha-1] (let [options (list /.lux-library /.jvm-library - /.pom /.md5 /.sha1) + /.pom /.md5 /.sha-1) uniques (set.from-list text.hash options)] (n.= (list.size options) (set.size uniques)))) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index 21e318be6..bc6bb1b4b 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -40,7 +40,7 @@ (`` ($_ _.and (_.with-cover [/.equivalence] ($_ _.and - ($equivalence.spec /.equivalence (..random /.sha1)) + ($equivalence.spec /.equivalence (..random /.sha-1)) ($equivalence.spec /.equivalence (..random /.md5)) )) (_.with-cover [/.data] @@ -64,14 +64,14 @@ (#try.Failure error) (exception.match? <exception> error)))))] - [/.sha1 /.as-sha1 /.not-a-sha1] + [/.sha-1 /.as-sha-1 /.not-a-sha-1] [/.md5 /.as-md5 /.not-a-md5] )))) (~~ (template [<codec> <hash>] [(_.with-cover [<codec>] ($codec.spec /.equivalence <codec> (..random <hash>)))] - [/.sha1-codec /.sha1] + [/.sha-1-codec /.sha-1] [/.md5-codec /.md5] )) (_.with-cover [/.not-a-hash] @@ -89,7 +89,7 @@ (#try.Failure error) (exception.match? /.not-a-hash error))))] - [/.sha1-codec /.sha1] + [/.sha-1-codec /.sha-1] [/.md5-codec /.md5] )))) )))) diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux new file mode 100644 index 000000000..b85f6ce4a --- /dev/null +++ b/stdlib/source/test/aedifex/package.lux @@ -0,0 +1,64 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + [concurrency + [promise (#+ Promise)]]] + [data + ["." text] + [collection + ["." set (#+ Set)]] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]] + [world + ["." file]]] + [// + ["@." profile] + [// + [lux + [data + ["_." binary]]]]] + {#program + ["." / + ["/#" // #_ + ["#" profile] + ["#." dependency (#+ Dependency)] + ["#." pom] + ["#." hash]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Package]) + (do {! random.monad} + [content-size (:: ! map (n.% 100) random.nat) + content (_binary.random content-size) + [profile pom] (random.one (function (_ profile) + (try.to-maybe + (do try.monad + [pom (//pom.write profile)] + (wrap [profile pom])))) + @profile.random)] + ($_ _.and + (_.cover [/.local] + (let [package (/.local pom content)] + (and (:: //hash.equivalence = + (//hash.sha-1 content) + (get@ #/.sha-1 package)) + (:: //hash.equivalence = + (//hash.md5 content) + (get@ #/.md5 package))))) + (_.cover [/.dependencies] + (let [expected (get@ #//.dependencies profile)] + (case (/.dependencies (/.local pom content)) + (#try.Success actual) + (:: set.equivalence = expected actual) + + (#try.Failure error) + false))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index f63de1509..d31e6aef8 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -1,7 +1,8 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)] @@ -18,143 +19,144 @@ [// ["." promise (#+ Promise Resolver) ("#@." monad)]]]}) -(exception: get-wrecked) +(exception: got-wrecked) -(actor: Counter +(actor: counter Nat - ((handle [message state self]) + ((on-mail message state self) (message state self)) - ((stop [cause state]) - (promise@wrap []))) + ((on-stop cause state) + (promise@wrap [])) -(message: #export Counter - (count! {increment Nat} state self Nat) - (let [state' (n.+ increment state)] - (promise@wrap (#try.Success [state' state'])))) + (message: (count! {increment Nat} state self Nat) + (let [state' (n.+ increment state)] + (promise@wrap (#try.Success [state' state'])))) + ) + +(def: (mailed? outcome) + (-> (Try Any) Bit) + (case outcome + (#try.Success _) true + (#try.Failure _) false)) (def: #export test Test (do random.monad - [initial-state random.nat] + [initial-state random.nat + #let [inc! (: (/.Mail Nat) + (function (_ state actor) + (promise@wrap + (#try.Success + (inc state)))))]] (<| (_.covering /._) (_.with-cover [/.Actor]) ($_ _.and (_.cover [/.alive?] (io.run (do io.monad - [actor (/.spawn /.default-behavior 0)] + [actor (/.spawn! /.default 0)] (/.alive? actor)))) + + (_.cover [/.poison!] + (let [poisoned-actors-die! + (io.run (do io.monad + [actor (/.spawn! /.default 0) + poisoned? (/.poison! actor) + alive? (/.alive? actor)] + (wrap (and (..mailed? poisoned?) + (not alive?))))) + + cannot-poison-more-than-once! + (io.run (do io.monad + [actor (/.spawn! /.default 0) + first-time? (/.poison! actor) + second-time? (/.poison! actor)] + (wrap (and (..mailed? first-time?) + (not (..mailed? second-time?))))))] + (and poisoned-actors-die! + cannot-poison-more-than-once!))) - (_.cover [/.poison] - (and (io.run (do io.monad - [actor (/.spawn /.default-behavior 0) - poisoned? (/.poison actor) - alive? (/.alive? actor)] - (wrap (and poisoned? - (not alive?))))) - (io.run (do io.monad - [actor (/.spawn /.default-behavior 0) - first-time? (/.poison actor) - second-time? (/.poison actor)] - (wrap (and first-time? - (not second-time?))))))) - - (let [inc! (: (/.Message Nat) - (function (_ state actor) - (promise@wrap - (#try.Success - (inc state)))))] - (:: random.monad wrap - (do promise.monad + (let [[read write] (: [(Promise Text) (Resolver Text)] + (promise.promise []))] + (wrap (do promise.monad + [_ (promise.future (do io.monad + [actor (/.spawn! (: (/.Behavior Any Any) + {#/.on-init (|>>) + #/.on-mail (function (_ message state self) + (message state self)) + #/.on-stop (function (_ cause state) + (promise.future (write cause)))}) + [])] + (/.poison! actor))) + _ (promise.wait 100) + result (promise.future (promise.poll read))] + (_.claim [/.poisoned] + (case result + (#.Some error) + (exception.match? /.poisoned error) + + #.None + false))))) + + (wrap (do promise.monad + [sent? (promise.future (do io.monad + [actor (/.spawn! /.default 0) + sent? (/.mail! inc! actor)] + (wrap (..mailed? sent?))))] + (_.claim [/.Behavior /.Mail + /.default /.spawn! /.mail!] + sent?))) + + (wrap (do promise.monad [result (promise.future (do io.monad - [actor (/.spawn /.default-behavior 0) - sent? (/.send inc! actor)] - (wrap (#try.Success sent?))))] - (_.claim [/.Behavior /.Message - /.default-behavior /.spawn /.send] + [counter (/.spawn! /.default 0) + _ (/.poison! counter)] + (/.mail! inc! counter)))] + (_.claim [/.dead] (case result (#try.Success outcome) - outcome + false (#try.Failure error) - false))))) + (exception.match? /.dead error))))) - (let [[read write] (: [(Promise Text) (Resolver Text)] - (promise.promise []))] - (:: random.monad wrap - (do promise.monad - [_ (promise.future (do io.monad - [actor (/.spawn {#/.handle (function (_ message state self) - (message state self)) - #/.end (function (_ cause state) - (promise.future (write cause)))} - write)] - (/.poison actor))) - _ (promise.wait 100) - result (promise.future (promise.poll read))] - (_.claim [/.poisoned] - (case result - (#.Some error) - (exception.match? /.poisoned error) - - #.None - false))))) - - (:: random.monad wrap - (do promise.monad - [result (do (try.with promise.monad) - [#let [counter (io.run (new@Counter 0))] - output-1 (count! 1 counter) - output-2 (count! 1 counter) - output-3 (count! 1 counter)] - (wrap (and (n.= 1 output-1) - (n.= 2 output-2) - (n.= 3 output-3))))] - (_.claim [/.actor: /.message:] - (case result - (#try.Success outcome) - outcome - - (#try.Failure error) - false)))) - - (:: random.monad wrap - (do promise.monad - [result (do (try.with promise.monad) - [counter (promise.future (do io.monad - [counter (new@Counter 0) - _ (/.poison counter)] - (wrap (#try.Success counter))))] - (count! 1 counter))] - (_.claim [/.dead] - (case result - (#try.Success outcome) - false - - (#try.Failure error) - (exception.match? /.dead error))))) - - (let [die! (: (/.Message Nat) + (let [die! (: (/.Mail Nat) (function (_ state actor) - (promise@wrap (exception.throw ..get-wrecked []))))] - (:: random.monad wrap - (do promise.monad - [result (promise.future (do io.monad - [actor (/.spawn /.default-behavior initial-state) - sent? (/.send die! actor) - alive? (/.alive? actor) - obituary (/.obituary actor)] - (wrap (#try.Success [actor sent? alive? obituary]))))] - (_.claim [/.Obituary /.obituary] + (promise@wrap (exception.throw ..got-wrecked []))))] + (wrap (do promise.monad + [result (promise.future (do io.monad + [actor (/.spawn! /.default initial-state) + sent? (/.mail! die! actor) + alive? (/.alive? actor) + obituary (/.obituary actor)] + (wrap (#try.Success [actor sent? alive? obituary]))))] + (_.claim [/.Obituary /.obituary] + (case result + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) + (and (..mailed? sent?) + (not alive?) + (exception.match? ..got-wrecked error) + (n.= initial-state state) + (is? die! single-pending-message)) + + _ + false))))) + + (wrap (do promise.monad + [counter (promise.future (/.spawn! ..counter 0)) + result (do (try.with promise.monad) + [output-1 (/.tell! (count! 1) counter) + output-2 (/.tell! (count! 1) counter) + output-3 (/.tell! (count! 1) counter)] + (wrap (and (n.= 1 output-1) + (n.= 2 output-2) + (n.= 3 output-3))))] + (_.claim [/.actor: /.message: /.tell!] (case result - (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) - (and sent? - (not alive?) - (exception.match? ..get-wrecked error) - (n.= initial-state state) - (is? die! single-pending-message)) - - _ - false))))) + (#try.Success outcome) + outcome + + (#try.Failure error) + false)))) )))) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 98b8bab90..b02a94f0f 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -89,8 +89,8 @@ (Random Code) (random.rec (function (_ recur) - (let [random-sequence (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat)] + (let [random-sequence (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] (random.list size recur))] ($_ random.and ..random-location @@ -106,8 +106,8 @@ ..random-name random-sequence random-sequence - (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] (random.list size (random.and recur recur))) ))))))) @@ -125,8 +125,8 @@ (<| (_.with-cover [/.Size]) (`` ($_ _.and (~~ (template [<size> <parser> <format>] - [(do {@ random.monad} - [expected (:: @ map (i64.and (i64.mask <size>)) + [(do {! random.monad} + [expected (:: ! map (i64.and (i64.mask <size>)) random.nat)] (_.cover [<size> <parser>] (|> (format.run <format> expected) @@ -145,8 +145,8 @@ Test (`` ($_ _.and (~~ (template [<parser> <format>] - [(do {@ random.monad} - [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + [(do {! random.monad} + [expected (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [<parser>] (|> (format.run <format> expected) (/.run <parser>) @@ -163,7 +163,7 @@ Test (`` ($_ _.and (~~ (template [<parser> <format>] - [(do {@ random.monad} + [(do {! random.monad} [expected (random.ascii ..segment-size)] (_.cover [<parser>] (|> (format.run <format> expected) @@ -182,7 +182,7 @@ Test (`` ($_ _.and (~~ (template [<parser> <format>] - [(do {@ random.monad} + [(do {! random.monad} [expected (random.row ..segment-size random.nat)] (_.cover [<parser>] (|> expected @@ -201,7 +201,7 @@ Test (`` ($_ _.and (~~ (template [<parser> <format> <random> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<parser>] (|> expected @@ -214,7 +214,7 @@ [/.nat format.nat random.nat n.equivalence] [/.int format.int random.int int.equivalence] [/.rev format.rev random.rev rev.equivalence])) - (do {@ random.monad} + (do {! random.monad} [expected random.frac] (_.cover [/.frac] (|> expected @@ -224,8 +224,8 @@ (or (:: frac.equivalence = expected actual) (and (frac.not-a-number? expected) (frac.not-a-number? actual)))))))) - (do {@ random.monad} - [expected (:: @ map (|>> (i64.and (i64.mask /.size/8)) + (do {! random.monad} + [expected (:: ! map (|>> (i64.and (i64.mask /.size/8)) (n.max 2)) random.nat)] (_.cover [/.not-a-bit] @@ -240,7 +240,7 @@ Test (`` ($_ _.and (~~ (template [<parser> <format> <random> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<parser>] (|> expected @@ -254,7 +254,7 @@ [/.type format.type random-type type.equivalence] )) (~~ (template [<cover> <parser> <format> <random> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<cover>] (|> expected @@ -267,15 +267,15 @@ [/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)] [/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence] [/.name /.name format.name ..random-name name.equivalence])) - (do {@ random.monad} - [expected (:: @ map (list.repeat ..segment-size) random.nat)] + (do {! random.monad} + [expected (:: ! map (list.repeat ..segment-size) random.nat)] (_.cover [/.set-elements-are-not-unique] (|> expected (format.run (format.list format.nat)) (/.run (/.set n.hash /.nat)) (!expect (^multi (#try.Failure error) (exception.match? /.set-elements-are-not-unique error)))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.or random.bit random.nat)] (_.cover [/.or] (|> expected @@ -286,8 +286,8 @@ (:: (sum.equivalence bit.equivalence n.equivalence) = expected actual)))))) - (do {@ random.monad} - [tag (:: @ map (|>> (i64.and (i64.mask /.size/8)) + (do {! random.monad} + [tag (:: ! map (|>> (i64.and (i64.mask /.size/8)) (n.max 2)) random.nat) value random.bit] @@ -298,7 +298,7 @@ (/.or /.bit /.nat))) (!expect (^multi (#try.Failure error) (exception.match? /.invalid-tag error)))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.list ..segment-size random.nat)] (_.cover [/.rec] (|> expected @@ -324,22 +324,22 @@ (|> (binary.create 0) (/.run /.any) (!expect (#try.Success _)))) - (do {@ random.monad} - [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (do {! random.monad} + [data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [/.binary-was-not-fully-read] (|> data (/.run /.any) (!expect (^multi (#try.Failure error) (exception.match? /.binary-was-not-fully-read error)))))) - (do {@ random.monad} - [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (do {! random.monad} + [expected (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [/.segment] (|> expected (/.run (/.segment ..segment-size)) (!expect (^multi (#try.Success actual) (:: binary.equivalence = expected actual)))))) - (do {@ random.monad} - [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (do {! random.monad} + [data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [/.end?] (|> data (/.run (do <>.monad @@ -349,9 +349,9 @@ (wrap (and (not pre) post)))) (!expect (#try.Success #1))))) - (do {@ random.monad} - [to-read (:: @ map (n.% (inc ..segment-size)) random.nat) - data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (do {! random.monad} + [to-read (:: ! map (n.% (inc ..segment-size)) random.nat) + data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [/.Offset /.offset] (|> data (/.run (do <>.monad @@ -364,9 +364,9 @@ (n.= to-read offset) (n.= ..segment-size nothing-left))))) (!expect (#try.Success #1))))) - (do {@ random.monad} - [to-read (:: @ map (n.% (inc ..segment-size)) random.nat) - data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (do {! random.monad} + [to-read (:: ! map (n.% (inc ..segment-size)) random.nat) + data (:: ! map encoding.to-utf8 (random.ascii ..segment-size))] (_.cover [/.remaining] (|> data (/.run (do <>.monad diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index 2c781e4fc..7d90eb49d 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -29,8 +29,8 @@ Test (<| (_.covering /._) (_.with-cover [/.Parser]) - (do {@ random.monad} - [expected (:: @ map n@encode random.nat) + (do {! random.monad} + [expected (:: ! map n@encode random.nat) #let [random-dummy (random.filter (|>> (text@= expected) not) (random.unicode 5))] dummy random-dummy diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index 8ed632ac5..4b3bfeb7d 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -44,8 +44,8 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) (`` ($_ _.and - (do {@ random.monad} - [expected (:: @ map (|>> #json.String) (random.unicode 1))] + (do {! random.monad} + [expected (:: ! map (|>> #json.String) (random.unicode 1))] (_.cover [/.run /.any] (|> (/.run /.any expected) (!expect (^multi (#try.Success actual) @@ -54,7 +54,7 @@ (|> (/.run /.null #json.Null) (!expect (#try.Success _)))) (~~ (template [<query> <test> <check> <random> <json> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random> dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] ($_ _.and @@ -77,21 +77,21 @@ [/.number /.number? /.number! ..safe-frac #json.Number frac.equivalence] [/.string /.string? /.string! (random.unicode 1) #json.String text.equivalence] )) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1) dummy random.bit] (_.cover [/.unexpected-value] (|> (/.run /.string (#json.Boolean dummy)) (!expect (^multi (#try.Failure error) (exception.match? /.unexpected-value error)))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1) dummy (|> (random.unicode 1) (random.filter (|>> (:: text.equivalence = expected) not)))] (_.cover [/.value-mismatch] (|> (/.run (/.string! expected) (#json.String dummy)) (!expect (^multi (#try.Failure error) (exception.match? /.value-mismatch error)))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1)] (_.cover [/.nullable] (and (|> (/.run (/.nullable /.string) #json.Null) @@ -100,18 +100,18 @@ (|> (/.run (/.nullable /.string) (#json.String expected)) (!expect (^multi (#try.Success actual) (:: (maybe.equivalence text.equivalence) = (#.Some expected) actual))))))) - (do {@ random.monad} - [size (:: @ map (n.% 10) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 10) random.nat) expected (|> (random.unicode 1) (random.list size) - (:: @ map row.from-list))] + (:: ! map row.from-list))] (_.cover [/.array] (|> (/.run (/.array (<>.some /.string)) (#json.Array (row@map (|>> #json.String) expected))) (!expect (^multi (#try.Success actual) (:: (row.equivalence text.equivalence) = expected (row.from-list actual))))))) - (do {@ random.monad} - [expected (:: @ map (|>> #json.String) (random.unicode 1))] + (do {! random.monad} + [expected (:: ! map (|>> #json.String) (random.unicode 1))] (_.cover [/.unconsumed-input] (|> (/.run (/.array /.any) (#json.Array (row expected expected))) (!expect (^multi (#try.Failure error) @@ -120,12 +120,12 @@ (|> (/.run (/.array /.any) (#json.Array (row))) (!expect (^multi (#try.Failure error) (exception.match? /.empty-input error))))) - (do {@ random.monad} + (do {! random.monad} [expected-boolean random.bit expected-number ..safe-frac expected-string (random.unicode 1) [boolean-field number-field string-field] (|> (random.set text.hash 3 (random.unicode 3)) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (case> (^ (list boolean-field number-field string-field)) [boolean-field number-field string-field] @@ -145,8 +145,8 @@ (and (:: bit.equivalence = expected-boolean actual-boolean) (:: frac.equivalence = expected-number actual-number) (:: text.equivalence = expected-string actual-string))))))) - (do {@ random.monad} - [size (:: @ map (n.% 10) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 10) random.nat) keys (random.list size (random.unicode 1)) values (random.list size (random.unicode 1)) #let [expected (dictionary.from-list text.hash (list.zip/2 keys values))]] diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 4b207b257..206b93b12 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -68,50 +68,50 @@ (def: character-classes Test ($_ _.and - (do {@ random.monad} - [offset (:: @ map (n.% 50) random.nat) - range (:: @ map (|>> (n.% 50) (n.+ 10)) random.nat) + (do {! random.monad} + [offset (:: ! map (n.% 50) random.nat) + range (:: ! map (|>> (n.% 50) (n.+ 10)) random.nat) #let [limit (n.+ offset range)] - expected (:: @ map (|>> (n.% range) (n.+ offset) text.from-code) random.nat) + expected (:: ! map (|>> (n.% range) (n.+ offset) text.from-code) random.nat) out-of-range (case offset - 0 (:: @ map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat) - _ (:: @ map (|>> (n.% offset) text.from-code) random.nat))] + 0 (:: ! map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat) + _ (:: ! map (|>> (n.% offset) text.from-code) random.nat))] (_.cover [/.range] (and (..should-pass expected (/.range offset limit)) (..should-fail out-of-range (/.range offset limit))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.char unicode.ascii/upper-alpha) invalid (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not) (random.char unicode.full))] (_.cover [/.upper] (and (..should-pass (text.from-code expected) /.upper) (..should-fail (text.from-code invalid) /.upper)))) - (do {@ random.monad} + (do {! random.monad} [expected (random.char unicode.ascii/lower-alpha) invalid (random.filter (|>> (unicode.within? unicode.basic-latin/lower-alpha) not) (random.char unicode.full))] (_.cover [/.lower] (and (..should-pass (text.from-code expected) /.lower) (..should-fail (text.from-code invalid) /.lower)))) - (do {@ random.monad} - [expected (:: @ map (n.% 10) random.nat) + (do {! random.monad} + [expected (:: ! map (n.% 10) random.nat) invalid (random.char (unicode.set [unicode.number-forms (list)]))] (_.cover [/.decimal] (and (..should-pass (:: n.decimal encode expected) /.decimal) (..should-fail (text.from-code invalid) /.decimal)))) - (do {@ random.monad} - [expected (:: @ map (n.% 8) random.nat) + (do {! random.monad} + [expected (:: ! map (n.% 8) random.nat) invalid (random.char (unicode.set [unicode.number-forms (list)]))] (_.cover [/.octal] (and (..should-pass (:: n.octal encode expected) /.octal) (..should-fail (text.from-code invalid) /.octal)))) - (do {@ random.monad} - [expected (:: @ map (n.% 16) random.nat) + (do {! random.monad} + [expected (:: ! map (n.% 16) random.nat) invalid (random.char (unicode.set [unicode.number-forms (list)]))] (_.cover [/.hexadecimal] (and (..should-pass (:: n.hex encode expected) /.hexadecimal) (..should-fail (text.from-code invalid) /.hexadecimal)))) - (do {@ random.monad} + (do {! random.monad} [expected (random.char unicode.ascii/alpha) invalid (random.filter (function (_ char) (not (or (unicode.within? unicode.basic-latin/upper-alpha char) @@ -120,7 +120,7 @@ (_.cover [/.alpha] (and (..should-pass (text.from-code expected) /.alpha) (..should-fail (text.from-code invalid) /.alpha)))) - (do {@ random.monad} + (do {! random.monad} [expected (random.char unicode.ascii/alpha-num) invalid (random.filter (function (_ char) (not (or (unicode.within? unicode.basic-latin/upper-alpha char) @@ -130,7 +130,7 @@ (_.cover [/.alpha-num] (and (..should-pass (text.from-code expected) /.alpha-num) (..should-fail (text.from-code invalid) /.alpha-num)))) - (do {@ random.monad} + (do {! random.monad} [expected ($_ random.either (wrap text.tab) (wrap text.vertical-tab) @@ -148,14 +148,14 @@ (_.cover [/.space] (and (..should-pass expected /.space) (..should-fail invalid /.space)))) - (do {@ random.monad} + (do {! random.monad} [#let [num-options 3] options (|> (random.char unicode.full) (random.set n.hash num-options) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list@map text.from-code) (text.join-with "")))) - expected (:: @ map (function (_ value) + expected (:: ! map (function (_ value) (|> options (text.nth (n.% num-options value)) maybe.assume)) @@ -174,14 +174,14 @@ (..should-fail (text.from-code invalid) (/.one-of! options)) (..should-fail' (text.from-code invalid) (/.one-of! options) /.character-should-be)))) - (do {@ random.monad} + (do {! random.monad} [#let [num-options 3] options (|> (random.char unicode.full) (random.set n.hash num-options) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list@map text.from-code) (text.join-with "")))) - invalid (:: @ map (function (_ value) + invalid (:: ! map (function (_ value) (|> options (text.nth (n.% num-options value)) maybe.assume)) @@ -206,27 +206,27 @@ Test (let [octal! (/.one-of! "01234567")] ($_ _.and - (do {@ random.monad} - [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat) - right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat) + (do {! random.monad} + [left (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat) + right (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat) #let [expected (format left right)] invalid (|> random.nat - (:: @ map (n.% 16)) + (:: ! map (n.% 16)) (random.filter (n.>= 8)) - (:: @ map (:: n.hex encode)))] + (:: ! map (:: n.hex encode)))] (_.cover [/.many /.many!] (and (..should-pass expected (/.many /.octal)) (..should-fail invalid (/.many /.octal)) (..should-pass! expected (/.many! octal!))))) - (do {@ random.monad} - [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat) - right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat) + (do {! random.monad} + [left (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat) + right (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat) #let [expected (format left right)] invalid (|> random.nat - (:: @ map (n.% 16)) + (:: ! map (n.% 16)) (random.filter (n.>= 8)) - (:: @ map (:: n.hex encode)))] + (:: ! map (:: n.hex encode)))] (_.cover [/.some /.some!] (and (..should-pass expected (/.some /.octal)) (..should-pass "" (/.some /.octal)) @@ -234,8 +234,8 @@ (..should-pass! expected (/.some! octal!)) (..should-pass! "" (/.some! octal!))))) - (do {@ random.monad} - [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)] + (do {! random.monad} + [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)] first octal second octal third octal] @@ -247,8 +247,8 @@ (..should-pass! (format first second) (/.exactly! 2 octal!)) (..should-fail (format first second third) (/.exactly! 2 octal!)) (..should-fail (format first) (/.exactly! 2 octal!))))) - (do {@ random.monad} - [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)] + (do {! random.monad} + [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)] first octal second octal third octal] @@ -260,8 +260,8 @@ (..should-pass! (format first second) (/.at-most! 2 octal!)) (..should-pass! (format first) (/.at-most! 2 octal!)) (..should-fail (format first second third) (/.at-most! 2 octal!))))) - (do {@ random.monad} - [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)] + (do {! random.monad} + [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)] first octal second octal third octal] @@ -273,8 +273,8 @@ (..should-pass! (format first second) (/.at-least! 2 octal!)) (..should-pass! (format first second third) (/.at-least! 2 octal!)) (..should-fail (format first) (/.at-least! 2 octal!))))) - (do {@ random.monad} - [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)] + (do {! random.monad} + [#let [octal (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)] first octal second octal third octal] @@ -293,7 +293,7 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) ($_ _.and - (do {@ random.monad} + (do {! random.monad} [sample (random.unicode 1)] (_.cover [/.run /.end!] (and (|> (/.run /.end! @@ -302,7 +302,7 @@ (|> (/.run /.end! sample) (!expect (#try.Failure _)))))) - (do {@ random.monad} + (do {! random.monad} [#let [size 10] expected (random.unicode size) dummy (|> (random.unicode size) @@ -320,7 +320,7 @@ (/.run (/.slice /.any!)) (!expect (^multi (#try.Failure error) (exception.match? /.cannot-slice error))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1)] (_.cover [/.any /.any!] (and (..should-pass expected /.any) @@ -328,7 +328,7 @@ (..should-pass! expected /.any!) (..should-fail "" /.any!)))) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1)] (_.cover [/.peek /.cannot-parse] (and (..should-pass expected (<>.before /.any /.peek)) @@ -336,14 +336,14 @@ (/.run (<>.before /.any /.peek)) (!expect (^multi (#try.Failure error) (exception.match? /.cannot-parse error))))))) - (do {@ random.monad} + (do {! random.monad} [dummy (random.unicode 1)] (_.cover [/.unconsumed-input] (|> (format dummy dummy) (/.run /.any) (!expect (^multi (#try.Failure error) (exception.match? /.unconsumed-input error)))))) - (do {@ random.monad} + (do {! random.monad} [sample (random.unicode 1)] (_.cover [/.Offset /.offset] (|> sample @@ -353,7 +353,7 @@ post /.offset] (wrap [pre post]))) (!expect (#try.Success [0 1]))))) - (do {@ random.monad} + (do {! random.monad} [left (random.unicode 1) right (random.unicode 1) #let [input (format left right)]] @@ -367,7 +367,7 @@ (wrap (and (text@= input pre) (text@= right post))))) (!expect (#try.Success #1))))) - (do {@ random.monad} + (do {! random.monad} [left (random.unicode 1) right (random.unicode 1) expected (random.filter (|>> (text@= right) not) @@ -376,7 +376,7 @@ (|> (format left expected right) (/.run (/.enclosed [left right] (/.this expected))) (!expect (#try.Success _))))) - (do {@ random.monad} + (do {! random.monad} [in (random.unicode 1) out (random.unicode 1)] (_.cover [/.local] @@ -385,14 +385,14 @@ [_ (/.local in (/.this in))] (/.this out))) (!expect (#try.Success _))))) - (do {@ random.monad} - [expected (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)] + (do {! random.monad} + [expected (:: ! map (|>> (n.% 8) (:: n.octal encode)) random.nat)] (_.cover [/.embed] (|> (list (code.text expected)) (<c>.run (/.embed /.octal <c>.text)) (!expect (^multi (#try.Success actual) (text@= expected actual)))))) - (do {@ random.monad} + (do {! random.monad} [invalid (random.ascii/upper-alpha 1) expected (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not) @@ -410,7 +410,7 @@ (/.run (/.not! upper!)) (!expect (^multi (#try.Failure error) (exception.match? /.expected-to-fail error))))))) - (do {@ random.monad} + (do {! random.monad} [upper (random.ascii/upper-alpha 1) lower (random.ascii/lower-alpha 1) invalid (random.filter (function (_ char) @@ -427,7 +427,7 @@ (..should-pass! (format upper lower) (/.and! upper! lower!)) (..should-fail (format (text.from-code invalid) lower) (/.and! upper! lower!)) (..should-fail (format upper (text.from-code invalid)) (/.and! upper! lower!))))) - (do {@ random.monad} + (do {! random.monad} [expected (random.unicode 1) invalid (random.unicode 1)] (_.cover [/.satisfies /.character-does-not-satisfy-predicate] diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 99e995f2d..10925cb12 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -34,7 +34,7 @@ (def: matches Test (<| (_.with-cover [/.types-do-not-match]) - (do {@ random.monad} + (do {! random.monad} [expected ..primitive dummy (random.filter (|>> (type@= expected) not) ..primitive)]) @@ -69,7 +69,7 @@ (def: aggregate Test - (do {@ random.monad} + (do {! random.monad} [expected-left ..primitive expected-middle ..primitive expected-right ..primitive] @@ -120,13 +120,13 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) ($_ _.and - (do {@ random.monad} + (do {! random.monad} [expected ..primitive] (_.cover [/.run /.any] (|> (/.run /.any expected) (!expect (^multi (#try.Success actual) (type@= expected actual)))))) - (do {@ random.monad} + (do {! random.monad} [expected ..primitive] (_.cover [/.peek /.unconsumed-input] (and (|> (/.run (do //.monad @@ -139,7 +139,7 @@ (|> (/.run /.peek expected) (!expect (^multi (#try.Failure error) (exception.match? /.unconsumed-input error))))))) - (do {@ random.monad} + (do {! random.monad} [expected ..primitive] (_.cover [/.empty-input] (`` (and (~~ (template [<parser>] @@ -153,7 +153,7 @@ [/.any] [/.peek] )))))) - (do {@ random.monad} + (do {! random.monad} [expected ..primitive] (_.cover [/.Env /.env /.fresh] (|> (/.run (do //.monad @@ -163,7 +163,7 @@ expected) (!expect (^multi (#try.Success environment) (is? /.fresh environment)))))) - (do {@ random.monad} + (do {! random.monad} [expected ..primitive dummy (random.filter (|>> (type@= expected) not) ..primitive)] @@ -175,14 +175,14 @@ dummy) (!expect (^multi (#try.Success actual) (type@= expected actual)))))) - (do {@ random.monad} + (do {! random.monad} [expected random.nat] (_.cover [/.existential /.not-existential] (|> (/.run /.existential (#.Ex expected)) (!expect (^multi (#try.Success actual) (n.= expected actual)))))) - (do {@ random.monad} + (do {! random.monad} [expected-name (random.and (random.ascii/alpha-num 1) (random.ascii/alpha-num 1)) expected-type ..primitive] diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index b46994c97..db7a51d39 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -34,7 +34,7 @@ (template: (!failure <exception> <cases>) (with-expansions [<<cases>> (template.splice <cases>)] - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/alpha 1)] (_.cover [<exception>] (`` (and (~~ (template [<parser> <input>] @@ -57,7 +57,7 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) ($_ _.and - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/alpha 1)] (_.cover [/.run /.text] (|> (/.run /.text (#xml.Text expected)) @@ -66,12 +66,12 @@ (!failure /.unconsumed-inputs [[(//@wrap expected) (#xml.Text expected)]]) - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/alpha 1)] (_.cover [/.ignore] (|> (/.run /.ignore (#xml.Text expected)) (!expect (#try.Success []))))) - (do {@ random.monad} + (do {! random.monad} [expected ..random-tag] (_.cover [/.node] (|> (/.run (do //.monad @@ -82,7 +82,7 @@ (!failure /.wrong-tag [[(/.node ["" expected]) (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) - (do {@ random.monad} + (do {! random.monad} [expected-tag ..random-tag expected-attribute ..random-attribute expected-value (random.ascii/alpha 1)] @@ -104,13 +104,13 @@ (|> (dictionary.new name.hash) (dictionary.put [expected ""] expected)) (list))]]) - (do {@ random.monad} + (do {! random.monad} [expected ..random-tag] (_.cover [/.children] - (|> (/.run (do {@ //.monad} + (|> (/.run (do {! //.monad} [_ (/.node expected)] (/.children - (do @ + (do ! [_ (/.node expected)] /.ignore))) (#xml.Node expected @@ -161,10 +161,10 @@ [_ (/.attribute [expected expected])] /.ignore) (#xml.Text expected)] - [(do {@ //.monad} + [(do {! //.monad} [_ (/.node [expected expected])] (/.children - (do @ + (do ! [_ (/.node [expected expected])] /.ignore))) (#xml.Text expected)]]) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 287a93526..6ae68a061 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -42,28 +42,6 @@ [_ (wrap [])] body))) -(def: number - Test - ## TODO: Inline ASAP - (let [part0 ($_ _.and - /i8.test - /i16.test - /i32.test - /i64.test) - part1 ($_ _.and - /nat.test - /int.test - /rev.test) - part2 ($_ _.and - /frac.test - /ratio.test - /complex.test)] - ($_ _.and - (!bundle part0) - (!bundle part1) - (!bundle part2) - ))) - (def: text ($_ _.and /text.test @@ -93,10 +71,10 @@ /product.test) test2 ($_ _.and /sum.test - ..number ..text ..format - /collection.test)] + /collection.test + )] ($_ _.and (!bundle test0) (!bundle test1) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index a81de6c24..2190c2fe2 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -177,7 +177,8 @@ (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.monoid] (do {! random.monad} - [sample ..random + [sample (random.filter (|>> /.size (n.> 0)) + ..random) #let [size (/.size sample)] idx (:: ! map (n.% size) random.nat) chunk-size (:: ! map (|>> (n.% size) inc) random.nat)] diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 8ba66ef02..ccd4a1d70 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -1,63 +1,91 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract - [monad (#+ do)] + ["." monad (#+ do)] {[0 #spec] [/ ["$." equivalence] ["$." fold] ["$." functor]]}] [data + ["." product] [number ["n" nat]] [collection ["." list ("#@." functor fold)]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Tree)]}) -(def: #export (tree size gen-value) - (All [a] (-> Nat (Random a) (Random (Tree a)))) - (let [singleton (:: r.monad map /.leaf gen-value)] - (case size - 0 - singleton - - 1 - singleton - - 2 - (do r.monad - [value gen-value - single (tree 1 gen-value)] - (wrap (/.branch value (list single)))) - - _ - (do r.monad - [value gen-value - #let [size (dec size)] - left (tree (n./ 2 size) gen-value) - right (tree (n.+ (n.% 2 size) (n./ 2 size)) - gen-value)] - (wrap (/.branch value (list left right)))) - ))) +(def: #export (tree gen-value) + (All [a] (-> (Random a) (Random [Nat (Tree a)]))) + (do {! random.monad} + [value gen-value + num-children (:: ! map (n.% 2) random.nat) + children (random.list num-children (tree gen-value))] + (wrap [(|> children + (list@map product.left) + (list@fold n.+ 1)) + {#/.value value + #/.children (list@map product.right children)}]))) (def: #export test Test - (<| (_.context (%.name (name-of /.Tree))) - (do {! r.monad} - [size (:: ! map (|>> (n.% 100) (n.+ 1)) r.nat)] - ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat)) - ($fold.spec /.leaf /.equivalence /.fold) - ($functor.spec /.leaf /.equivalence /.functor) - - (do ! - [sample (..tree size r.nat)] - (_.test "Can flatten a tree to get all the nodes as a flat tree." - (n.= size - (list.size (/.flatten sample))))) - )))) + (<| (_.covering /._) + (_.with-cover [/.Tree]) + ($_ _.and + (_.with-cover [/.equivalence] + (|> (..tree random.nat) + (:: random.monad map product.right) + ($equivalence.spec (/.equivalence n.equivalence)))) + (_.with-cover [/.fold] + ($fold.spec /.leaf /.equivalence /.fold)) + (_.with-cover [/.functor] + ($functor.spec /.leaf /.equivalence /.functor)) + + (do random.monad + [[size sample] (..tree random.nat)] + (_.cover [/.flatten] + (n.= size + (list.size (/.flatten sample))))) + (do random.monad + [expected random.nat] + (_.cover [/.leaf] + (:: (list.equivalence n.equivalence) = + (list expected) + (/.flatten (/.leaf expected))))) + (do {! random.monad} + [value random.nat + num-children (:: ! map (n.% 3) random.nat) + children (random.list num-children random.nat)] + (_.cover [/.branch] + (:: (list.equivalence n.equivalence) = + (list& value children) + (/.flatten (/.branch value (list@map /.leaf children)))))) + (do random.monad + [expected/0 random.nat + expected/1 random.nat + expected/2 random.nat + expected/3 random.nat + expected/4 random.nat + expected/5 random.nat] + (_.cover [/.tree] + (and (:: (list.equivalence n.equivalence) = + (list expected/0) + (/.flatten (/.tree expected/0))) + (:: (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2) + (/.flatten (/.tree expected/0 + {expected/1 {} + expected/2 {}}))) + (:: (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2 + expected/3 expected/4 expected/5) + (/.flatten (/.tree expected/0 + {expected/1 {} + expected/2 {expected/3 {} + expected/4 {expected/5 {}}}}))) + ))) + ))) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 7354eafed..6d0ab8a6c 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -24,8 +24,7 @@ Test (<| (_.context (%.name (name-of /.Zipper))) (do {! r.monad} - [size (:: ! map (|>> (n.% 90) (n.+ 10)) r.nat) - sample (//.tree size r.nat) + [[size sample] (//.tree r.nat) mid-val r.nat new-val r.nat pre-val r.nat diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index b59ae9ca2..faa3fa85f 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -61,11 +61,11 @@ (^template [<tag> <gen> <wrapper>] [_ (<tag> _)] (if allow-literals? - (do {@ r.monad} + (do {! r.monad} [?sample (r.maybe <gen>)] (case ?sample (#.Some sample) - (do @ + (do ! [else (exhaustive-branches allow-literals? variantTC inputC)] (wrap (list& (<wrapper> sample) else))) @@ -82,8 +82,8 @@ (r@wrap (list (' []))) [_ (#.Tuple members)] - (do {@ r.monad} - [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] + (do {! r.monad} + [member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving (list@map code.tuple)))) @@ -92,19 +92,19 @@ (r@wrap (list (' {}))) [_ (#.Record kvs)] - (do {@ r.monad} + (do {! r.monad} [#let [ks (list@map product.left kvs) vs (list@map product.right kvs)] - member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)] + member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) vs)] (wrap (|> member-wise-patterns exhaustive-weaving (list@map (|>> (list.zip/2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) - (do {@ r.monad} - [bundles (monad.map @ + (do {! r.monad} + [bundles (monad.map ! (function (_ [_tag _code]) - (do @ + (do ! [v-branches (exhaustive-branches allow-literals? variantTC _code)] (wrap (list@map (function (_ pattern) (` ((~ _tag) (~ pattern)))) v-branches)))) @@ -121,13 +121,13 @@ (function (_ input) ($_ r.either (r@map product.right _primitive.primitive) - (do {@ r.monad} - [choice (|> r.nat (:: @ map (n.% (list.size variant-tags)))) + (do {! r.monad} + [choice (|> r.nat (:: ! map (n.% (list.size variant-tags)))) #let [choiceT (maybe.assume (list.nth choice variant-tags)) choiceC (maybe.assume (list.nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) elems (r.list size input)] (wrap (code.tuple elems))) (r@wrap (code.record (list.zip/2 record-tags primitivesC))) @@ -139,13 +139,13 @@ (def: #export test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} + (do {! r.monad} [module-name (r.unicode 5) variant-name (r.unicode 5) record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not))) - size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) + size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) + record-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) primitivesTC (r.list size _primitive.primitive) #let [primitivesT (list@map product.left primitivesTC) primitivesC (list@map product.right primitivesTC) @@ -183,10 +183,10 @@ (_.test "Will reject non-exhaustive pattern-matching." (|> (analyse-pm non-exhaustive-branchesC) _structure.check-fails))) - (do @ + (do ! [redundant-patterns (exhaustive-branches false variantTC inputC) - redundancy-idx (|> r.nat (:: @ map (n.% (list.size redundant-patterns)))) - #let [redundant-branchesC (<| (list@map (branch outputC)) + redundancy-idx (|> r.nat (:: ! map (n.% (list.size redundant-patterns)))) + #let [redundant-branchesC (<| (list!map (branch outputC)) list.concat (list (list.take redundancy-idx redundant-patterns) (list (maybe.assume (list.nth redundancy-idx redundant-patterns))) @@ -194,10 +194,10 @@ (_.test "Will reject redundant pattern-matching." (|> (analyse-pm redundant-branchesC) _structure.check-fails))) - (do @ + (do ! [[heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not) _primitive.primitive) - heterogeneous-idx (|> r.nat (:: @ map (n.% (list.size exhaustive-patterns)))) + heterogeneous-idx (|> r.nat (:: ! map (n.% (list.size exhaustive-patterns)))) #let [heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC) (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))] [_pattern heterogeneousC])) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 3dbacc0e2..4fa365850 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -80,10 +80,10 @@ )))) (def: apply - (do {@ r.monad} - [full-args (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - partial-args (|> r.nat (:: @ map (n.% full-args))) - var-idx (|> r.nat (:: @ map (|>> (n.% full-args) (n.max 1)))) + (do {! r.monad} + [full-args (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + partial-args (|> r.nat (:: ! map (n.% full-args))) + var-idx (|> r.nat (:: ! map (|>> (n.% full-args) (n.max 1)))) inputsTC (r.list full-args _primitive.primitive) #let [inputsT (list@map product.left inputsTC) inputsC (list@map product.right inputsTC)] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 7197dbca6..b67193533 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -49,11 +49,11 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do {@ phase.monad} + (|> (do {! phase.monad} [_ (//module.with-module 0 def-module (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module - (do @ + (do ! [_ (if import? (//module.import def-module) (wrap []))] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 6da982c17..fc6d49b3d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -117,11 +117,11 @@ false))) (def: sum - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - choice (|> r.nat (:: @ map (n.% size))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + choice (|> r.nat (:: ! map (n.% size))) primitives (r.list size _primitive.primitive) - +choice (|> r.nat (:: @ map (n.% (inc size)))) + +choice (|> r.nat (:: ! map (n.% (inc size)))) [_ +valueC] _primitive.primitive #let [variantT (type.variant (list@map product.left primitives)) [valueT valueC] (maybe.assume (list.nth choice primitives)) @@ -169,10 +169,10 @@ )))) (def: product - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) primitives (r.list size _primitive.primitive) - choice (|> r.nat (:: @ map (n.% size))) + choice (|> r.nat (:: ! map (n.% size))) [_ +valueC] _primitive.primitive #let [tupleT (type.tuple (list@map product.left primitives)) [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume) @@ -229,11 +229,11 @@ )))) (def: variant - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - choice (|> r.nat (:: @ map (n.% size))) - other-choice (|> r.nat (:: @ map (n.% size)) (r.filter (|>> (n.= choice) not))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) + choice (|> r.nat (:: ! map (n.% size))) + other-choice (|> r.nat (:: ! map (n.% size)) (r.filter (|>> (n.= choice) not))) primitives (r.list size _primitive.primitive) module-name (r.unicode 5) type-name (r.unicode 5) @@ -275,13 +275,13 @@ )))) (def: record - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) primitives (r.list size _primitive.primitive) module-name (r.unicode 5) type-name (r.unicode 5) - choice (|> r.nat (:: @ map (n.% size))) + choice (|> r.nat (:: ! map (n.% size))) #let [varT (#.Parameter 1) tagsC (list@map (|>> [module-name] code.tag) tags) primitivesT (list@map product.left primitives) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index a7686e0f2..0c0a2d467 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -72,10 +72,10 @@ (def: i64 Test - (do {@ r.monad} - [subjectC (|> r.nat (:: @ map code.nat)) - signedC (|> r.int (:: @ map code.int)) - paramC (|> r.nat (:: @ map code.nat))] + (do {! r.monad} + [subjectC (|> r.nat (:: ! map code.nat)) + signedC (|> r.int (:: ! map code.int)) + paramC (|> r.nat (:: ! map code.nat))] ($_ _.and (_.test "i64 'and'." (check-success+ "lux i64 and" (list paramC subjectC) Nat)) @@ -99,9 +99,9 @@ (def: int Test - (do {@ r.monad} - [subjectC (|> r.int (:: @ map code.int)) - paramC (|> r.int (:: @ map code.int))] + (do {! r.monad} + [subjectC (|> r.int (:: ! map code.int)) + paramC (|> r.int (:: ! map code.int))] ($_ _.and (_.test "Can multiply integers." (check-success+ "lux i64 *" (list paramC subjectC) Int)) @@ -119,10 +119,10 @@ (def: frac Test - (do {@ r.monad} - [subjectC (|> r.safe-frac (:: @ map code.frac)) - paramC (|> r.safe-frac (:: @ map code.frac)) - encodedC (|> r.safe-frac (:: @ map (|>> %.frac code.text)))] + (do {! r.monad} + [subjectC (|> r.safe-frac (:: ! map code.frac)) + paramC (|> r.safe-frac (:: ! map code.frac)) + encodedC (|> r.safe-frac (:: ! map (|>> %.frac code.text)))] ($_ _.and (_.test "Can add frac numbers." (check-success+ "lux f64 +" (list paramC subjectC) Frac)) @@ -154,12 +154,12 @@ (def: text Test - (do {@ r.monad} - [subjectC (|> (r.unicode 5) (:: @ map code.text)) - paramC (|> (r.unicode 5) (:: @ map code.text)) - replacementC (|> (r.unicode 5) (:: @ map code.text)) - fromC (|> r.nat (:: @ map code.nat)) - toC (|> r.nat (:: @ map code.nat))] + (do {! r.monad} + [subjectC (|> (r.unicode 5) (:: ! map code.text)) + paramC (|> (r.unicode 5) (:: ! map code.text)) + replacementC (|> (r.unicode 5) (:: ! map code.text)) + fromC (|> r.nat (:: ! map code.nat)) + toC (|> r.nat (:: ! map code.nat))] ($_ _.and (_.test "Can test text equivalence." (check-success+ "lux text =" (list paramC subjectC) Bit)) @@ -179,9 +179,9 @@ (def: io Test - (do {@ r.monad} - [logC (|> (r.unicode 5) (:: @ map code.text)) - exitC (|> r.int (:: @ map code.int))] + (do {! r.monad} + [logC (|> (r.unicode 5) (:: ! map code.text)) + exitC (|> r.int (:: ! map code.int))] ($_ _.and (_.test "Can log messages to standard output." (check-success+ "lux io log" (list logC) Any)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 0789d5ddd..45706256b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -44,13 +44,13 @@ (template [<name> <synthesis> <random>] [(def: (<name> context) (Scenario Synthesis) - (do {@ random.monad} + (do {! random.monad} [value <random>] (wrap [(<synthesis> value) (<synthesis> value)])))] [bit-scenario synthesis.bit random.bit] - [i64-scenario synthesis.i64 (:: @ map .i64 random.nat)] + [i64-scenario synthesis.i64 (:: ! map .i64 random.nat)] [f64-scenario synthesis.f64 random.frac] [text-scenario synthesis.text (random.unicode 1)] ) @@ -64,10 +64,10 @@ (def: (with-redundancy scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [redundant? random.bit] (if redundant? - (do @ + (do ! [let? random.bit [expected-input actual-input] (..primitive-scenario context) #let [fake-register (n.+ (get@ #redundants context) @@ -86,7 +86,7 @@ (def: (variant-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [lefts random.nat right? random.bit [expected input] (scenario context)] @@ -142,8 +142,8 @@ (def: (get-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} - [length (:: @ map (|>> (n.% 5) inc) random.nat) + (do {! random.monad} + [length (:: ! map (|>> (n.% 5) inc) random.nat) path (random.list length ..random-member) [expected-record actual-record] (scenario context)] (wrap [(synthesis.branch/get [path expected-record]) @@ -157,14 +157,14 @@ (-> (Scenario Synthesis) (Scenario Path)) (`` ($_ random.either ($_ random.either - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) [expected-then actual-then] (scenario context)] (wrap [(#synthesis.Seq #synthesis.Pop (#synthesis.Then expected-then)) (#synthesis.Seq #synthesis.Pop (#synthesis.Then actual-then))])) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) #let [real-register (dictionary.size (get@ #necessary context)) fake-register (n.+ (get@ #redundants context) @@ -178,7 +178,7 @@ (#synthesis.Then actual-then)))]))) ($_ random.either (~~ (template [<tag> <random>] - [(do {@ random.monad} + [(do {! random.monad} [test <random> [expected-then actual-then] (scenario context)] (wrap [(#synthesis.Seq (#synthesis.Test (<tag> test)) @@ -187,26 +187,26 @@ (#synthesis.Then actual-then))]))] [#synthesis.Bit random.bit] - [#synthesis.I64 (:: @ map .i64 random.nat)] + [#synthesis.I64 (:: ! map .i64 random.nat)] [#synthesis.F64 random.frac] [#synthesis.Text (random.unicode 1)] ))) ($_ random.either - (do {@ random.monad} + (do {! random.monad} [side ..random-side [expected-next actual-next] (path-scenario scenario context)] (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) expected-next) (#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) actual-next)])) - (do {@ random.monad} + (do {! random.monad} [member ..random-member [expected-next actual-next] (path-scenario scenario context)] (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) expected-next) (#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) actual-next)]))) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) [expected-left actual-left] (path-scenario scenario context) [expected-right actual-right] (path-scenario scenario context)] @@ -216,7 +216,7 @@ (def: (case-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) [expected-input actual-input] (scenario context) [expected-path actual-path] (..path-scenario scenario context)] @@ -236,7 +236,7 @@ (def: (scope-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) #let [real-start (dictionary.size (get@ #necessary context)) fake-start (n.+ (get@ #redundants context) @@ -256,7 +256,7 @@ (def: (recur-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) resets (random.list ..scope-arity (scenario context))] (wrap [(synthesis.loop/recur (list@map product.left resets)) @@ -271,7 +271,7 @@ (def: (abstraction-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} + (do {! random.monad} [_ (wrap []) #let [registers (dictionary.entries (get@ #necessary context)) expected-environment (list@map (|>> product.left #variable.Local) registers) @@ -282,8 +282,8 @@ (def: (apply-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - (do {@ random.monad} - [abstraction (:: @ map (|>> synthesis.constant) + (do {! random.monad} + [abstraction (:: ! map (|>> synthesis.constant) (random.and (random.unicode 1) (random.unicode 1))) inputs (random.list ..scope-arity (scenario context))] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 819f6ccf1..7c2ece82e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -26,8 +26,8 @@ (def: name-part^ (Random Text) - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 20) (n.max 1))))] + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 20) (n.max 1))))] (r.ascii/lower-alpha size))) (def: name^ @@ -73,7 +73,7 @@ (def: code Test - (do {@ r.monad} + (do {! r.monad} [sample code^] ($_ _.and (_.test "Can parse Lux code." @@ -85,7 +85,7 @@ (#.Right [_ parsed]) (:: code.equivalence = parsed sample))) - (do @ + (do ! [other code^] (_.test "Can parse multiple Lux code nodes." (let [source-code (format (%.code sample) " " (%.code other)) |