From 69272f598d831e89da83bdc8c9290d5607dfb14d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 31 Oct 2020 20:26:37 -0400 Subject: Re-named the directory for my bookmarks to better reflect what they are. --- stdlib/source/test/aedifex.lux | 4 +- stdlib/source/test/aedifex/command/install.lux | 101 +++++++++++++++++++++ stdlib/source/test/lux/abstract/interval.lux | 16 ++-- stdlib/source/test/lux/abstract/predicate.lux | 4 +- stdlib/source/test/lux/control/continuation.lux | 8 +- .../source/test/lux/control/parser/synthesis.lux | 32 +++---- stdlib/source/test/lux/control/pipe.lux | 4 +- stdlib/source/test/lux/data/binary.lux | 6 +- stdlib/source/test/lux/data/collection/array.lux | 14 +-- stdlib/source/test/lux/data/collection/bits.lux | 14 +-- .../lux/data/collection/dictionary/ordered.lux | 4 +- stdlib/source/test/lux/data/collection/list.lux | 26 +++--- stdlib/source/test/lux/data/collection/queue.lux | 4 +- .../test/lux/data/collection/queue/priority.lux | 10 +- stdlib/source/test/lux/data/collection/row.lux | 24 ++--- .../source/test/lux/data/collection/sequence.lux | 8 +- .../test/lux/data/collection/set/ordered.lux | 6 +- stdlib/source/test/lux/data/collection/stack.lux | 85 ++++++++--------- stdlib/source/test/lux/data/collection/tree.lux | 6 +- .../test/lux/data/collection/tree/zipper.lux | 8 +- stdlib/source/test/lux/data/color.lux | 10 +- stdlib/source/test/lux/data/number/complex.lux | 12 +-- stdlib/source/test/lux/data/number/i16.lux | 4 +- stdlib/source/test/lux/data/number/i32.lux | 4 +- stdlib/source/test/lux/data/number/i64.lux | 4 +- stdlib/source/test/lux/data/number/i8.lux | 4 +- stdlib/source/test/lux/host.old.lux | 6 +- stdlib/source/test/lux/macro/poly/equivalence.lux | 6 +- stdlib/source/test/lux/macro/poly/json.lux | 4 +- stdlib/source/test/lux/macro/template.lux | 2 +- stdlib/source/test/lux/meta.lux | 4 +- stdlib/source/test/lux/time/duration.lux | 6 +- stdlib/source/test/lux/type.lux | 20 ++-- stdlib/source/test/lux/type/check.lux | 18 ++-- stdlib/source/test/lux/type/implicit.lux | 4 +- stdlib/source/test/lux/world/file.lux | 6 +- 36 files changed, 301 insertions(+), 197 deletions(-) create mode 100644 stdlib/source/test/aedifex/command/install.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index c40939b47..dec078509 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -9,7 +9,8 @@ ["#." artifact] ["#." input] ["#." command #_ - ["#/." pom]] + ["#/." pom] + ["#/." install]] ["#." local] ["#." dependency] ["#." profile] @@ -25,6 +26,7 @@ /artifact.test /input.test /command/pom.test + /command/install.test /local.test /dependency.test /profile.test diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux new file mode 100644 index 000000000..7f8a4557f --- /dev/null +++ b/stdlib/source/test/aedifex/command/install.lux @@ -0,0 +1,101 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try) ("#@." functor)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." maybe] + ["." binary] + ["." text ("#@." equivalence) + ["%" format (#+ format)] + ["." encoding]] + [format + ["." xml]] + [collection + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ Path File)]]] + [/// + ["@." profile]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." artifact + ["#/." extension]]]]}) + +(def: (make-sources! fs sources) + (-> (file.System Promise) (Set Path) (Promise (Try Any))) + (loop [sources (set.to-list sources)] + (case sources + #.Nil + (|> [] + (:: try.monad wrap) + (:: promise.monad wrap)) + + (#.Cons head tail) + (do (try.with promise.monad) + [_ (: (Promise (Try Path)) + (file.make-directories promise.monad fs head)) + _ (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs (format head (:: fs separator) head ".lux")))] + (recur tail))))) + +(def: (execute! fs sample) + (-> (file.System Promise) ///.Profile (Promise (Try Any))) + (do ///action.monad + [_ (..make-sources! fs (get@ #///.sources sample)) + _ (: (Promise (Try Path)) + (file.make-directories promise.monad fs (///local.repository fs)))] + (/.do! fs sample))) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [sample @profile.random + #let [fs (file.mock (:: file.default separator))]] + (wrap (case (get@ #///.identity sample) + (#.Some identity) + (do {@ promise.monad} + [verdict (do ///action.monad + [_ (..execute! fs sample) + #let [artifact-path (format (///local.path fs identity) + (:: fs separator) + (///artifact.identity identity)) + library-path (format artifact-path ///artifact/extension.lux-library) + pom-path (format artifact-path ///artifact/extension.pom)] + + library-exists! (:: promise.monad map + exception.return + (file.file-exists? promise.monad fs library-path)) + pom-exists! (:: promise.monad map + exception.return + (file.file-exists? promise.monad fs pom-path))] + (wrap (and library-exists! + pom-exists!)))] + (_.claim [/.do!] + (try.default false verdict))) + + #.None + (do {@ promise.monad} + [outcome (..execute! fs sample)] + (_.claim [/.do!] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + true)))))))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index dcfa85e73..7aea3a1c5 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -137,9 +137,9 @@ (def: location Test - (do {@ random.monad} + (do {! random.monad} [[l m r] (|> (random.set n.hash 3 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -159,9 +159,9 @@ (def: touch Test - (do {@ random.monad} + (do {! random.monad} [[b t1 t2] (|> (random.set n.hash 3 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -185,10 +185,10 @@ (def: nested Test - (do {@ random.monad} + (do {! random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -218,10 +218,10 @@ (def: overlap Test - (do {@ random.monad} + (do {! random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index ab101ea76..cf7f4f074 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -31,7 +31,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [sample random.nat samples (random.list 10 random.nat) #let [equivalence (: (Equivalence (/.Predicate Nat)) @@ -46,7 +46,7 @@ (let [generator (: (Random (/.Predicate Nat)) (|> random.nat (random.filter (|>> (n.= 0) not)) - (:: @ map multiple?)))] + (:: ! map multiple?)))] ($_ _.and (_.with-cover [/.union] ($monoid.spec equivalence /.union generator)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 0b0538745..99b56cfdc 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -48,10 +48,10 @@ (n.= sample (/.run (_@wrap sample)))) (_.cover [/.call/cc] (n.= (n.* 2 sample) - (/.run (do {@ /.monad} + (/.run (do {! /.monad} [value (/.call/cc (function (_ k) - (do @ + (do ! [temp (k sample)] ## If this code where to run, ## the output would be @@ -76,9 +76,9 @@ (_@wrap #.Nil) (#.Cons x xs') - (do {@ /.monad} + (do {! /.monad} [output (/.shift (function (_ k) - (do @ + (do ! [tail (k xs')] (wrap (#.Cons x tail)))))] (visit output)))))] diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index dc341a44f..4d6a359da 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -51,10 +51,10 @@ (def: random-environment (Random (Environment Synthesis)) - (do {@ random.monad} - [size (:: @ map (n.% 5) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 5) random.nat)] (|> ..random-variable - (:: @ map (|>> synthesis.variable)) + (:: ! map (|>> synthesis.variable)) (random.list size)))) (def: valid-frac @@ -65,7 +65,7 @@ Test (`` ($_ _.and (~~ (template [ ] - [(do {@ random.monad} + [(do {! random.monad} [expected dummy (|> (random.filter (|>> (:: = expected) not)))] ($_ _.and @@ -81,7 +81,7 @@ (exception.match? /.cannot-parse error))))))))] [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] + [/.i64 /.i64! (:: ! map .i64 random.nat) synthesis.i64 i64.equivalence] [/.f64 /.f64! ..valid-frac synthesis.f64 frac.equivalence] [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] @@ -93,9 +93,9 @@ (def: complex Test ($_ _.and - (do {@ random.monad} + (do {! random.monad} [expected-bit random.bit - expected-i64 (:: @ map .i64 random.nat) + expected-i64 (:: ! map .i64 random.nat) expected-f64 ..valid-frac expected-text (random.unicode 1)] (_.cover [/.tuple] @@ -113,7 +113,7 @@ (list (synthesis.text expected-text))) (!expect (^multi (#try.Failure error) (exception.match? /.cannot-parse error))))))) - (do {@ random.monad} + (do {! random.monad} [arity random.nat expected-environment ..random-environment expected-body (random.unicode 1)] @@ -140,8 +140,8 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) ($_ _.and - (do {@ random.monad} - [expected (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [expected (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.run /.any] (|> (/.run /.any (list expected)) (!expect (^multi (#try.Success actual) @@ -150,22 +150,22 @@ (|> (/.run /.any (list)) (!expect (^multi (#try.Failure error) (exception.match? /.empty-input error))))) - (do {@ random.monad} - [expected (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [expected (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.unconsumed-input] (|> (/.run /.any (list expected expected)) (!expect (^multi (#try.Failure error) (exception.match? /.unconsumed-input error)))))) - (do {@ random.monad} - [dummy (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [dummy (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.end! /.expected-empty-input] (and (|> (/.run /.end! (list)) (!expect (#try.Success _))) (|> (/.run /.end! (list dummy)) (!expect (^multi (#try.Failure error) (exception.match? /.expected-empty-input error))))))) - (do {@ random.monad} - [dummy (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [dummy (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.end?] (and (|> (/.run /.end? (list)) (!expect (#try.Success #1))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 1efc39cbc..247ae8be4 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -17,10 +17,10 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [sample random.nat] ($_ _.and - (do @ + (do ! [another random.nat] (_.cover [/.new>] (n.= (inc another) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index c011df720..d3bd06b58 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -77,12 +77,12 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [#let [gen-size (|> random.nat (:: @ map (|>> (n.% 100) (n.max 8))))] + (do {! random.monad} + [#let [gen-size (|> random.nat (:: ! map (|>> (n.% 100) (n.max 8))))] size gen-size sample (..random size) value random.nat - #let [gen-idx (|> random.nat (:: @ map (n.% size)))] + #let [gen-idx (|> random.nat (:: ! map (n.% size)))] [from to] (random.and gen-idx gen-idx) #let [[from to] [(n.min from to) (n.max from to)]]] (_.with-cover [/.Binary] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 4cd81db10..e09e502bc 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -35,7 +35,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Array]) - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size base random.nat shift random.nat @@ -109,8 +109,8 @@ _ false))) - (do @ - [occupancy (:: @ map (n.% (inc size)) random.nat)] + (do ! + [occupancy (:: ! map (n.% (inc size)) random.nat)] (_.cover [/.occupancy /.vacancy] (let [the-array (loop [output (: (Array Nat) (/.new size)) @@ -122,15 +122,15 @@ (and (n.= occupancy (/.occupancy the-array)) (n.= size (n.+ (/.occupancy the-array) (/.vacancy the-array))))))) - (do @ + (do ! [the-list (random.list size random.nat)] (_.cover [/.from-list /.to-list] (and (|> the-list /.from-list /.to-list (:: (list.equivalence n.equivalence) = the-list)) (|> the-array /.to-list /.from-list (:: (/.equivalence n.equivalence) = the-array))))) - (do @ - [amount (:: @ map (n.% (inc size)) random.nat)] + (do ! + [amount (:: ! map (n.% (inc size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.new size))] @@ -150,7 +150,7 @@ (and (n.= (list.size evens) (/.occupancy the-array)) (n.= (list.size odds) (/.vacancy the-array)) (|> the-array /.to-list (:: (list.equivalence n.equivalence) = evens)))))) - (do @ + (do ! [#let [the-array (/.clone the-array) members (|> the-array /.to-list (set.from-list n.hash))] default (random.filter (function (_ value) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index cadd2d26d..a31fec37c 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -22,12 +22,12 @@ (def: #export random (Random Bits) - (do {@ random.monad} - [size (:: @ map (n.% 1,000) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 1,000) random.nat)] (case size 0 (wrap /.empty) - _ (do {@ random.monad} - [idx (|> random.nat (:: @ map (n.% size)))] + _ (do {! random.monad} + [idx (|> random.nat (:: ! map (n.% size)))] (wrap (/.set idx /.empty)))))) (def: #export test @@ -47,9 +47,9 @@ (_.cover [/.empty] (/.empty? /.empty)) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 1,000) inc) random.nat) - idx (:: @ map (n.% size) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 1,000) inc) random.nat) + idx (:: ! map (n.% size) random.nat) sample ..random] ($_ _.and (_.cover [/.get /.set] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index f45f1d0d4..e396dd81a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -40,8 +40,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Dictionary))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 100))) keys (r.set n.hash size r.nat) values (r.set n.hash size r.nat) extra-key (|> r.nat (r.filter (|>> (set.member? keys) not))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 92cec10e8..a81de6c24 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -39,11 +39,11 @@ (def: random (Random (List Nat)) - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size] (|> random.nat (random.set n.hash size) - (:: @ map set.to-list)))) + (:: ! map set.to-list)))) (def: signatures Test @@ -61,7 +61,7 @@ (_.with-cover [/.monad] ($monad.spec /@wrap /.equivalence /.monad)) - (do {@ random.monad} + (do {! random.monad} [parameter random.nat subject random.nat] (let [lift (/.lift io.monad) @@ -81,10 +81,10 @@ (def: whole Test - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size #let [(^open "/@.") (/.equivalence n.equivalence)] - sample (:: @ map set.to-list (random.set n.hash size random.nat))] + sample (:: ! map set.to-list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -127,7 +127,7 @@ Test (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor] - (do {@ random.monad} + (do {! random.monad} [sample ..random #let [size (/.size sample)]] ($_ _.and @@ -176,11 +176,11 @@ Test (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.monoid] - (do {@ random.monad} + (do {! random.monad} [sample ..random #let [size (/.size sample)] - idx (:: @ map (n.% size) random.nat) - chunk-size (:: @ map (|>> (n.% size) inc) random.nat)] + idx (:: ! map (n.% size) random.nat) + chunk-size (:: ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.filter] (let [positives (/.filter n.even? sample) @@ -223,7 +223,7 @@ (def: member Test (let [(^open "/@.") (/.equivalence n.equivalence)] - (do {@ random.monad} + (do {! random.monad} [sample ..random] (`` ($_ _.and (_.cover [/.member?] @@ -270,7 +270,7 @@ +/3 (: (-> Nat Nat Nat Nat) (function (_ left mid right) ($_ n.+ left mid right)))] - (do {@ random.monad} + (do {! random.monad} [sample/0 ..random sample/1 ..random sample/2 ..random] @@ -352,7 +352,7 @@ (if (n.even? value) (#.Some (:: n.decimal encode value)) #.None)))] - (do {@ random.monad} + (do {! random.monad} [sample ..random] ($_ _.and (_.cover [/.one] @@ -390,7 +390,7 @@ (_.with-cover [.List]) (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor] - (do {@ random.monad} + (do {! random.monad} [sample ..random separator random.nat] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index f646fd82a..9cc7c4500 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -28,8 +28,8 @@ Test (<| (_.covering /._) (_.with-cover [/.Queue]) - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? members) not) random.nat) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 7f9b42046..555214148 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -15,10 +15,10 @@ (def: #export (queue size) (-> Nat (Random (Queue Nat))) - (do {@ r.monad} + (do {! r.monad} [inputs (r.list size r.nat)] - (monad.fold @ (function (_ head tail) - (do @ + (monad.fold ! (function (_ head tail) + (do ! [priority r.nat] (wrap (/.push priority head tail)))) /.empty @@ -27,8 +27,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 100))) sample (..queue size) non-member-priority r.nat non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not)))] diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index e096c9085..716b03168 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -28,8 +28,8 @@ (def: signatures Test - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat)] ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.row size random.nat))) @@ -47,8 +47,8 @@ (def: whole Test - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/@.") (/.equivalence n.equivalence)]] @@ -80,11 +80,11 @@ (def: index-based Test - (do {@ random.monad} - [size (:: @ map (|>> (n.% 100) inc) random.nat)] + (do {! random.monad} + [size (:: ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and - (do @ - [good-index (|> random.nat (:: @ map (n.% size))) + (do ! + [good-index (|> random.nat (:: ! map (n.% size))) #let [bad-index (n.+ size good-index)] sample (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? sample) not) @@ -133,21 +133,21 @@ Test (<| (_.covering /._) (_.with-cover [/.Row]) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 100) inc) random.nat)] + (do {! random.monad} + [size (:: ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and ..signatures ..whole ..index-based - (do @ + (do ! [sample (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? sample) not) random.nat) #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and - (do @ + (do ! [value/0 random.nat value/1 random.nat value/2 random.nat] diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 3cd41c4b2..ad1dd0448 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -36,11 +36,11 @@ (<| (_.covering /._) (_.with-cover [/.Sequence]) (let [(^open "list@.") (list.equivalence n.equivalence)]) - (do {@ random.monad} + (do {! random.monad} [repeated random.nat - index (:: @ map (n.% 100) random.nat) - size (:: @ map (|>> (n.% 10) inc) random.nat) - offset (:: @ map (n.% 100) random.nat) + index (:: ! map (n.% 100) random.nat) + size (:: ! map (|>> (n.% 10) inc) random.nat) + offset (:: ! map (n.% 100) random.nat) cycle-start random.nat cycle-next (random.list size random.nat)] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 867fa4308..335eb0226 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -46,11 +46,11 @@ ($_ _.and ($equivalence.spec /.equivalence (..set n.order r.nat size)) )) - (do {@ r.monad} + (do {! r.monad} [sizeL gen-nat sizeR gen-nat - listL (|> (r.set n.hash sizeL gen-nat) (:: @ map //.to-list)) - listR (|> (r.set n.hash sizeR gen-nat) (:: @ map //.to-list)) + listL (|> (r.set n.hash sizeL gen-nat) (:: ! map //.to-list)) + listR (|> (r.set n.hash sizeR gen-nat) (:: ! map //.to-list)) #let [(^open "/@.") /.equivalence setL (/.from-list n.order listL) setR (/.from-list n.order listR) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index a8a2ceeeb..80b7fce63 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -10,10 +9,11 @@ ["$." functor (#+ Injection)]]}] [data ["." maybe] + ["." bit ("#@." equivalence)] [number ["n" nat]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) @@ -21,48 +21,49 @@ (Injection /.Stack) (/.push value /.empty)) -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n.% 100)))) - (def: #export test Test - (<| (_.context (%.name (name-of /._))) - (do r.monad - [size gen-nat - sample (r.stack size gen-nat) - new-top gen-nat] + (<| (_.covering /._) + (_.with-cover [/.Stack]) + (do random.monad + [size (:: random.monad map (n.% 100) random.nat) + sample (random.stack size random.nat) + expected-top random.nat] ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (r.stack size r.nat)) - ($functor.spec ..injection /.equivalence /.functor) + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - (_.test (%.name (name-of /.size)) - (n.= size (/.size sample))) - (_.test (%.name (name-of /.peek)) - (case (/.peek sample) - #.None (/.empty? sample) - (#.Some _) (not (/.empty? sample)))) - (_.test (%.name (name-of /.pop)) - (case (/.size sample) - 0 (case (/.pop sample) - #.None - (/.empty? sample) - - (#.Some _) - false) - expected (case (/.pop sample) - (#.Some sample') - (and (n.= (dec expected) (/.size sample')) - (not (/.empty? sample))) - - #.None - false))) - (_.test (%.name (name-of /.push)) - (and (is? sample - (|> sample (/.push new-top) /.pop maybe.assume)) - (n.= (inc (/.size sample)) - (/.size (/.push new-top sample))) - (|> (/.push new-top sample) /.peek maybe.assume - (is? new-top)))) + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.peek] + (case (/.peek sample) + #.None + (/.empty? sample) + + (#.Some _) + (not (/.empty? sample)))) + (_.cover [/.pop] + (case (/.pop sample) + #.None + (/.empty? sample) + + (#.Some [top remaining]) + (:: (/.equivalence n.equivalence) = + sample + (/.push top remaining)))) + (_.cover [/.push] + (case (/.pop (/.push expected-top sample)) + (#.Some [actual-top actual-sample]) + (and (is? expected-top actual-top) + (is? sample actual-sample)) + + #.None + false)) )))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 37dd216b2..8ba66ef02 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -48,14 +48,14 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Tree))) - (do {@ r.monad} - [size (:: @ map (|>> (n.% 100) (n.+ 1)) r.nat)] + (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 @ + (do ! [sample (..tree size r.nat)] (_.test "Can flatten a tree to get all the nodes as a flat tree." (n.= size diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 74fda6cc1..7354eafed 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -23,8 +23,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Zipper))) - (do {@ r.monad} - [size (:: @ map (|>> (n.% 90) (n.+ 10)) r.nat) + (do {! r.monad} + [size (:: ! map (|>> (n.% 90) (n.+ 10)) r.nat) sample (//.tree size r.nat) mid-val r.nat new-val r.nat @@ -48,7 +48,7 @@ (|> child /.start (is? zipper) not))) (and (/.leaf? zipper) (|> zipper (/.prepend-child new-val) /.branch?))))) - (do @ + (do ! [branch-value r.nat #let [zipper (|> (/.zip (tree.branch branch-value (list (tree.leaf mid-val)))) (/.prepend-child pre-val) @@ -60,7 +60,7 @@ (|> zipper /.down /.right /.value (is? mid-val)) (and (|> zipper /.down /.right /.right /.value (is? post-val)) (|> zipper /.down /.rightmost /.value (is? post-val)))))) - (do @ + (do ! [branch-value r.nat #let [zipper (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))]] (_.test "Can insert children around a node (unless it's start)." diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 388b49d93..ca84d8b07 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -125,16 +125,16 @@ (def: palette Test (_.with-cover [/.Spread /.Palette] - (do {@ random.monad} - [eH (:: @ map (|>> f.abs (f.% +0.9) (f.+ +0.05)) + (do {! random.monad} + [eH (:: ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) random.safe-frac) #let [eS +0.5] - variations (:: @ map (|>> (n.% 3) (n.+ 2)) random.nat) + variations (:: ! map (|>> (n.% 3) (n.+ 2)) random.nat) #let [max-spread (f./ (|> variations inc .int int.frac) +1.0) min-spread (f./ +2.0 max-spread) spread-space (f.- min-spread max-spread)] - spread (:: @ map (|>> f.abs (f.% spread-space) (f.+ min-spread)) + spread (:: ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) random.safe-frac)] (`` ($_ _.and (~~ (template [ ] @@ -175,7 +175,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Color]) - (do {@ random.monad} + (do {! random.monad} [expected ..color] ($_ _.and (_.with-cover [/.equivalence] diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 330361792..091814105 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -34,8 +34,8 @@ (def: dimension (Random Frac) - (do {@ r.monad} - [factor (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1)))) + (do {! r.monad} + [factor (|> r.nat (:: ! map (|>> (n.% 1000) (n.max 1)))) measure (|> r.safe-frac (r.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -159,8 +159,8 @@ (def: trigonometry Test - (do {@ r.monad} - [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) + (do {! r.monad} + [angle (|> ..complex (:: ! map (|>> (update@ #/.real (f.% +1.0)) (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and (_.test "Arc-sine is the inverse of sine." @@ -183,9 +183,9 @@ (def: root Test - (do {@ r.monad} + (do {! r.monad} [sample ..complex - degree (|> r.nat (:: @ map (|>> (n.max 1) (n.% 5))))] + degree (|> r.nat (:: ! map (|>> (n.max 1) (n.% 5))))] (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/data/number/i16.lux index a00a26e9e..edfadf62d 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/data/number/i16.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i16) diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/data/number/i32.lux index d126e5b03..f5d32ba21 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/data/number/i32.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i32) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 592b5fe41..6834f6276 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -22,9 +22,9 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} + (do {! r.monad} [pattern r.nat - idx (:: @ map (//nat.% /.width) r.nat)] + idx (:: ! map (//nat.% /.width) r.nat)] ($_ _.and ($equivalence.spec /.equivalence r.i64) ($monoid.spec //nat.equivalence /.disjunction r.nat) diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/data/number/i8.lux index aac5f063a..53b196e41 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/data/number/i8.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i8) diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index 457caee6a..e0f2a3757 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -117,9 +117,9 @@ (def: arrays Test - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) - idx (|> r.nat (:: @ map (n.% size))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 100) (n.max 1)))) + idx (|> r.nat (:: ! map (n.% size))) value r.int] ($_ _.and (_.test "Can create arrays of some length." diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 985da657c..1790c0111 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -50,9 +50,9 @@ (def: gen-record (Random Record) - (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat) - #let [gen-int (|> random.int (:: @ map (|>> i.abs (i.% +1,000,000))))]] + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat) + #let [gen-int (|> random.int (:: ! map (|>> i.abs (i.% +1,000,000))))]] ($_ random.and random.bit gen-int diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 8be02dc27..f052cdf0f 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -89,8 +89,8 @@ (def: gen-record (Random Record) - (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] ($_ random.and random.bit random.safe-frac diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 6e90ac1bb..8dff75251 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -16,7 +16,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [left random.nat mid random.nat right random.nat] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 18bc370c2..4ade3f2f8 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -227,12 +227,12 @@ Test (<| (_.covering /._) ($_ _.and - (do {@ random.monad} + (do {! random.monad} [target (random.ascii/upper-alpha 1) version (random.ascii/upper-alpha 1) source-code (random.ascii/upper-alpha 1) expected-current-module (random.ascii/upper-alpha 1) - expected-type (:: @ map (function (_ name) + expected-type (:: ! map (function (_ name) (#.Primitive name (list))) (random.ascii/upper-alpha 1)) expected-seed random.nat diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 5900f1958..7d40750a5 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -36,10 +36,10 @@ [millis random.int] (_.test "Can convert from/to milliseconds." (|> millis /.from-millis /.to-millis (i.= millis)))) - (do {@ random.monad} - [sample (|> duration (:: @ map (/.frame /.day))) + (do {! random.monad} + [sample (|> duration (:: ! map (/.frame /.day))) frame duration - factor (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + factor (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [(^open "/@.") /.order]] ($_ _.and (_.test "Can scale a duration." diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index eef749d8f..fca611825 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -22,8 +22,8 @@ (def: short (r.Random Text) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 10)))] + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 10)))] (r.unicode size))) (def: name @@ -83,8 +83,8 @@ (:: /.equivalence = (/.un-name base) (/.un-name aliased)))))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) members (|> ..type (r.filter (function (_ type) (case type @@ -94,7 +94,7 @@ _ #1))) (list.repeat size) - (M.seq @)) + (M.seq !)) #let [(^open "/@.") /.equivalence (^open "list@.") (list.equivalence /.equivalence)]] (`` ($_ _.and @@ -109,9 +109,9 @@ ["tuple" /.tuple /.flatten-tuple Any] )) ))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) - members (M.seq @ (list.repeat size ..type)) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) + members (M.seq ! (list.repeat size ..type)) extra (|> ..type (r.filter (function (_ type) (case type @@ -132,8 +132,8 @@ (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] (n.= (list.size members) (list.size tparams)))) )) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) extra (|> ..type (r.filter (function (_ type) (case type diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 5a0942252..d4bf9ed8e 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -81,11 +81,11 @@ (def: (build-ring num-connections) (-> Nat (/.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do {@ /.monad} + (do {! /.monad} [[head-id head-type] /.var - ids+types (monad.seq @ (list.repeat num-connections /.var)) - [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type]) - (do @ + ids+types (monad.seq ! (list.repeat num-connections /.var)) + [tail-id tail-type] (monad.fold ! (function (_ [tail-id tail-type] [_head-id _head-type]) + (do ! [_ (/.check head-type tail-type)] (wrap [tail-id tail-type]))) [head-id head-type] @@ -188,8 +188,8 @@ _ (/.check var Nothing)] (/.check .Bit var)))) ) - (do {@ r.monad} - [num-connections (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [num-connections (|> r.nat (:: ! map (n.% 100))) boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) pick-pcg (r.and r.nat r.nat)] ($_ _.and @@ -209,14 +209,14 @@ expected-size? same-vars?)))))) (_.test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do {@ /.monad} + (type-checks? (do {! /.monad} [[[head-id headT] ids+types tailT] (build-ring num-connections) #let [ids (list@map product.left ids+types)] _ (/.check headT boundT) head-bound (/.read head-id) - tail-bound (monad.map @ /.read ids) + tail-bound (monad.map ! /.read ids) headR (/.ring head-id) - tailR+ (monad.map @ /.ring ids)] + tailR+ (monad.map ! /.ring ids)] (let [rings-were-erased? (and (set.empty? headR) (list.every? set.empty? tailR+)) same-types? (list.every? (type@= boundT) (list& (maybe.default headT head-bound) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 7c55a0d6f..4cdb9009f 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -21,8 +21,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do {@ random.monad} - [#let [digit (:: @ map (n.% 10) random.nat)] + (do {! random.monad} + [#let [digit (:: ! map (n.% 10) random.nat)] left digit right digit #let [start (n.min left right) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index a1146fe56..55cfe94bc 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -68,11 +68,11 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do {@ r.monad} - [file-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) + (do {! r.monad} + [file-size (|> r.nat (:: ! map (|>> (n.% 100) (n.max 10)))) dataL (_binary.random file-size) dataR (_binary.random file-size) - new-modified (|> r.int (:: @ map (|>> i.abs + new-modified (|> r.int (:: ! map (|>> i.abs (i.% +10,000,000,000,000) truncate-millis duration.from-millis -- cgit v1.2.3