From a75f032ff219fdd639580455a6d3e83fd05d5592 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 6 Apr 2019 21:14:27 -0400 Subject: Created the "lux/abstract" branch and moved some modules into it. --- stdlib/source/test/licentia.lux | 3 +- stdlib/source/test/lux.lux | 5 +- stdlib/source/test/lux/abstract.lux | 11 + stdlib/source/test/lux/abstract/apply.lux | 71 ++++++ stdlib/source/test/lux/abstract/codec.lux | 26 +++ stdlib/source/test/lux/abstract/enum.lux | 27 +++ stdlib/source/test/lux/abstract/equivalence.lux | 25 +++ stdlib/source/test/lux/abstract/fold.lux | 20 ++ stdlib/source/test/lux/abstract/functor.lux | 58 +++++ stdlib/source/test/lux/abstract/interval.lux | 248 ++++++++++++++++++++ stdlib/source/test/lux/abstract/monad.lux | 58 +++++ stdlib/source/test/lux/abstract/monoid.lux | 24 ++ stdlib/source/test/lux/abstract/number.lux | 46 ++++ stdlib/source/test/lux/abstract/order.lux | 26 +++ stdlib/source/test/lux/cli.lux | 2 +- stdlib/source/test/lux/control.lux | 2 - stdlib/source/test/lux/control/apply.lux | 72 ------ stdlib/source/test/lux/control/codec.lux | 27 --- .../source/test/lux/control/concurrency/actor.lux | 2 +- .../source/test/lux/control/concurrency/atom.lux | 3 +- stdlib/source/test/lux/control/concurrency/frp.lux | 2 +- .../test/lux/control/concurrency/promise.lux | 2 +- .../test/lux/control/concurrency/semaphore.lux | 3 +- stdlib/source/test/lux/control/concurrency/stm.lux | 2 +- stdlib/source/test/lux/control/continuation.lux | 2 +- stdlib/source/test/lux/control/enum.lux | 28 --- stdlib/source/test/lux/control/equivalence.lux | 26 --- stdlib/source/test/lux/control/exception.lux | 3 +- stdlib/source/test/lux/control/fold.lux | 21 -- stdlib/source/test/lux/control/functor.lux | 58 ----- stdlib/source/test/lux/control/interval.lux | 249 --------------------- stdlib/source/test/lux/control/monad.lux | 58 ----- stdlib/source/test/lux/control/monoid.lux | 25 --- stdlib/source/test/lux/control/number.lux | 47 ---- stdlib/source/test/lux/control/order.lux | 27 --- stdlib/source/test/lux/control/parser.lux | 2 +- stdlib/source/test/lux/control/pipe.lux | 2 +- stdlib/source/test/lux/control/reader.lux | 2 +- stdlib/source/test/lux/control/region.lux | 3 +- .../source/test/lux/control/security/integrity.lux | 2 +- .../source/test/lux/control/security/privacy.lux | 7 +- stdlib/source/test/lux/control/state.lux | 5 +- stdlib/source/test/lux/control/thread.lux | 2 +- stdlib/source/test/lux/control/writer.lux | 2 +- stdlib/source/test/lux/data/bit.lux | 2 +- stdlib/source/test/lux/data/collection/array.lux | 5 +- stdlib/source/test/lux/data/collection/bits.lux | 2 +- .../source/test/lux/data/collection/dictionary.lux | 2 +- .../lux/data/collection/dictionary/ordered.lux | 2 +- stdlib/source/test/lux/data/collection/list.lux | 5 +- stdlib/source/test/lux/data/collection/queue.lux | 2 +- .../test/lux/data/collection/queue/priority.lux | 2 +- stdlib/source/test/lux/data/collection/row.lux | 2 +- .../source/test/lux/data/collection/sequence.lux | 4 +- stdlib/source/test/lux/data/collection/set.lux | 2 +- .../test/lux/data/collection/set/ordered.lux | 2 +- stdlib/source/test/lux/data/collection/stack.lux | 2 +- .../source/test/lux/data/collection/tree/rose.lux | 2 +- .../test/lux/data/collection/tree/rose/zipper.lux | 2 +- stdlib/source/test/lux/data/color.lux | 2 +- stdlib/source/test/lux/data/error.lux | 5 +- stdlib/source/test/lux/data/format/json.lux | 7 +- stdlib/source/test/lux/data/format/xml.lux | 7 +- stdlib/source/test/lux/data/identity.lux | 2 +- stdlib/source/test/lux/data/lazy.lux | 2 +- stdlib/source/test/lux/data/maybe.lux | 5 +- stdlib/source/test/lux/data/name.lux | 5 +- stdlib/source/test/lux/data/number/complex.lux | 2 +- stdlib/source/test/lux/data/number/frac.lux | 2 +- stdlib/source/test/lux/data/number/i64.lux | 2 +- stdlib/source/test/lux/data/number/int.lux | 2 +- stdlib/source/test/lux/data/number/nat.lux | 2 +- stdlib/source/test/lux/data/number/ratio.lux | 2 +- stdlib/source/test/lux/data/number/rev.lux | 2 +- stdlib/source/test/lux/data/text.lux | 5 +- stdlib/source/test/lux/data/text/lexer.lux | 2 +- stdlib/source/test/lux/data/text/regex.lux | 2 +- stdlib/source/test/lux/host.jvm.lux | 2 +- stdlib/source/test/lux/host/jvm.jvm.lux | 2 +- stdlib/source/test/lux/io.lux | 2 +- stdlib/source/test/lux/macro.lux | 2 +- stdlib/source/test/lux/macro/code.lux | 2 +- stdlib/source/test/lux/macro/poly/equivalence.lux | 4 +- stdlib/source/test/lux/macro/poly/functor.lux | 2 +- stdlib/source/test/lux/macro/poly/json.lux | 7 +- stdlib/source/test/lux/macro/syntax.lux | 5 +- stdlib/source/test/lux/math.lux | 3 +- stdlib/source/test/lux/math/infix.lux | 2 +- stdlib/source/test/lux/math/logic/continuous.lux | 2 +- stdlib/source/test/lux/math/logic/fuzzy.lux | 2 +- stdlib/source/test/lux/math/modular.lux | 2 +- stdlib/source/test/lux/time/date.lux | 3 +- stdlib/source/test/lux/time/day.lux | 2 +- stdlib/source/test/lux/time/duration.lux | 2 +- stdlib/source/test/lux/time/instant.lux | 5 +- stdlib/source/test/lux/time/month.lux | 2 +- stdlib/source/test/lux/type.lux | 2 +- stdlib/source/test/lux/type/check.lux | 3 +- stdlib/source/test/lux/type/dynamic.lux | 2 +- stdlib/source/test/lux/type/implicit.lux | 4 +- stdlib/source/test/lux/type/resource.lux | 2 +- stdlib/source/test/lux/world/binary.lux | 3 +- stdlib/source/test/lux/world/file.lux | 2 +- stdlib/source/test/lux/world/net/tcp.lux | 2 +- stdlib/source/test/lux/world/net/udp.lux | 2 +- 105 files changed, 762 insertions(+), 745 deletions(-) create mode 100644 stdlib/source/test/lux/abstract.lux create mode 100644 stdlib/source/test/lux/abstract/apply.lux create mode 100644 stdlib/source/test/lux/abstract/codec.lux create mode 100644 stdlib/source/test/lux/abstract/enum.lux create mode 100644 stdlib/source/test/lux/abstract/equivalence.lux create mode 100644 stdlib/source/test/lux/abstract/fold.lux create mode 100644 stdlib/source/test/lux/abstract/functor.lux create mode 100644 stdlib/source/test/lux/abstract/interval.lux create mode 100644 stdlib/source/test/lux/abstract/monad.lux create mode 100644 stdlib/source/test/lux/abstract/monoid.lux create mode 100644 stdlib/source/test/lux/abstract/number.lux create mode 100644 stdlib/source/test/lux/abstract/order.lux delete mode 100644 stdlib/source/test/lux/control/apply.lux delete mode 100644 stdlib/source/test/lux/control/codec.lux delete mode 100644 stdlib/source/test/lux/control/enum.lux delete mode 100644 stdlib/source/test/lux/control/equivalence.lux delete mode 100644 stdlib/source/test/lux/control/fold.lux delete mode 100644 stdlib/source/test/lux/control/functor.lux delete mode 100644 stdlib/source/test/lux/control/interval.lux delete mode 100644 stdlib/source/test/lux/control/monad.lux delete mode 100644 stdlib/source/test/lux/control/monoid.lux delete mode 100644 stdlib/source/test/lux/control/number.lux delete mode 100644 stdlib/source/test/lux/control/order.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index 1526b8a04..7f623d26d 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -2,9 +2,8 @@ [lux #* [cli (#+ program:)] ["_" test (#+ Test)] + [abstract/monad (#+ do)] [io (#+ io)] - [control - [monad (#+ do)]] [data ["." bit ("#;." equivalence)] ["." maybe ("#;." functor)] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 4caf29c32..5b45d6e5e 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -12,7 +12,7 @@ ["/" lux #* [cli (#+ program:)] ["." io (#+ io)] - [control + [abstract [monad (#+ do)] [predicate (#+ Predicate)]] [data @@ -112,6 +112,7 @@ ["." / #_ ["#." cli] ["#." io] + ["#." abstract] ["#." control] ["#." data] ["#." macro] @@ -354,6 +355,8 @@ ..cross-platform-support) /cli.test /io.test + (<| (_.context "/abstract") + /abstract.test) (<| (_.context "/control") /control.test) (<| (_.context "/data") diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux new file mode 100644 index 000000000..4d37ed458 --- /dev/null +++ b/stdlib/source/test/lux/abstract.lux @@ -0,0 +1,11 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." interval]]) + +(def: #export test + Test + ($_ _.and + /interval.test + )) diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux new file mode 100644 index 000000000..a269810bb --- /dev/null +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -0,0 +1,71 @@ +(.module: + [lux #* + [abstract/monad (#+ do)] + [data + [text + format]] + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ Apply)]} + [// + [functor (#+ Injection Comparison)]]) + +(def: (identity injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) + (do r.monad + [sample (:: @ map injection r.nat)] + (_.test "Identity." + ((comparison n/=) + (_;apply (injection function.identity) sample) + sample)))) + +(def: (homomorphism injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Homomorphism." + ((comparison n/=) + (_;apply (injection increase) (injection sample)) + (injection (increase sample)))))) + +(def: (interchange injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Interchange." + ((comparison n/=) + (_;apply (injection increase) (injection sample)) + (_;apply (injection (function (_ f) (f sample))) (injection increase)))))) + +(def: (composition injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat) + decrease (:: @ map n/- r.nat)] + (_.test "Composition." + ((comparison n/=) + (_$ _;apply + (injection function.compose) + (injection increase) + (injection decrease) + (injection sample)) + ($_ _;apply + (injection increase) + (injection decrease) + (injection sample)))))) + +(def: #export (spec injection comparison apply) + (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) + (_.context (%name (name-of /.Apply)) + ($_ _.and + (..identity injection comparison apply) + (..homomorphism injection comparison apply) + (..interchange injection comparison apply) + (..composition injection comparison apply) + ))) diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux new file mode 100644 index 000000000..80203c237 --- /dev/null +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -0,0 +1,26 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [data + text/format + ["." error]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Codec) + [// + [equivalence (#+ Equivalence)]]]}) + +(def: #export (spec (^open "/@.") (^open "/@.") generator) + (All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test)) + (do r.monad + [expected generator] + (<| (_.context (%name (name-of /.Codec))) + (_.test "Isomorphism." + (case (|> expected /@encode /@decode) + (#error.Success actual) + (/@= expected actual) + + (#error.Failure error) + false))))) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux new file mode 100644 index 000000000..63bbf97ad --- /dev/null +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -0,0 +1,27 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + ["." function] + [abstract/monad (#+ do)] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Enum)]}) + +(def: #export (spec (^open "/@.") gen-sample) + (All [a] (-> (Enum a) (Random a) Test)) + (do r.monad + [sample gen-sample] + (<| (_.context (%name (name-of /.Order))) + ($_ _.and + (_.test "Successor and predecessor are inverse functions." + (and (/@= (|> sample /@succ /@pred) + (function.identity sample)) + (/@= (|> sample /@pred /@succ) + (function.identity sample)) + (not (/@= (|> sample /@succ) + (function.identity sample))) + (not (/@= (|> sample /@pred) + (function.identity sample))))) + )))) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux new file mode 100644 index 000000000..d9e61131f --- /dev/null +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [data + [text + format]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Equivalence)]}) + +(def: #export (spec (^open "_@.") generator) + (All [a] (-> (Equivalence a) (Random a) Test)) + (do r.monad + [left generator + right generator] + (<| (_.context (%name (name-of /.Equivalence))) + ($_ _.and + (_.test "Reflexivity." + (_@= left left)) + (_.test "Symmetry." + (if (_@= left right) + (_@= right left) + (not (_@= right left)))))))) diff --git a/stdlib/source/test/lux/abstract/fold.lux b/stdlib/source/test/lux/abstract/fold.lux new file mode 100644 index 000000000..8dfe7fc4c --- /dev/null +++ b/stdlib/source/test/lux/abstract/fold.lux @@ -0,0 +1,20 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + data/text/format + ["r" math/random] + [abstract/monad (#+ do)]] + [// + [functor (#+ Injection Comparison)]] + {1 + ["." / (#+ Fold)]}) + +(def: #export (spec injection comparison (^open "/@.")) + (All [f] (-> (Injection f) (Comparison f) (Fold f) Test)) + (_.context (%name (name-of /.Fold)) + (do r.monad + [subject r.nat + parameter r.nat] + (_.test "Can fold." + (n/= (/@fold n/+ parameter (injection subject)) + (n/+ parameter subject)))))) diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux new file mode 100644 index 000000000..cf3538575 --- /dev/null +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -0,0 +1,58 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + data/text/format + ["r" math/random] + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + ["." function]] + {1 + ["." / (#+ Functor)]}) + +(type: #export (Injection f) + (All [a] (-> a (f a)))) + +(type: #export (Comparison f) + (All [a] + (-> (Equivalence a) + (Equivalence (f a))))) + +(def: (identity injection comparison (^open "/@.")) + (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) + (do r.monad + [sample (:: @ map injection r.nat)] + (_.test "Identity." + ((comparison n/=) + (/@map function.identity sample) + sample)))) + +(def: (homomorphism injection comparison (^open "/@.")) + (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Homomorphism." + ((comparison n/=) + (/@map increase (injection sample)) + (injection (increase sample)))))) + +(def: (composition injection comparison (^open "/@.")) + (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) + (do r.monad + [sample (:: @ map injection r.nat) + increase (:: @ map n/+ r.nat) + decrease (:: @ map n/- r.nat)] + (_.test "Composition." + ((comparison n/=) + (|> sample (/@map increase) (/@map decrease)) + (|> sample (/@map (|>> increase decrease))))))) + +(def: #export (spec injection comparison functor) + (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) + (_.context (%name (name-of /.Functor)) + ($_ _.and + (..identity injection comparison functor) + (..homomorphism injection comparison functor) + (..composition injection comparison functor) + ))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux new file mode 100644 index 000000000..cfc19f6a9 --- /dev/null +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -0,0 +1,248 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [abstract + {[0 #test] + [/ + ["$." equivalence]]}] + [control + [pipe (#+ case>)]] + [data + [number + ["." nat]] + [text + format] + [collection + ["." set] + ["." list]]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Interval) ("_@." equivalence)]}) + +(template [ ] + [(def: #export + (Random (Interval Nat)) + (do r.monad + [bottom r.nat + top (|> r.nat (r.filter (|>> (n/= bottom) not)))] + (if ( top bottom) + (wrap (/.between nat.enum bottom top)) + (wrap (/.between nat.enum top bottom)))))] + + [inner n/<] + [outer n/>] + ) + +(def: #export singleton + (Random (Interval Nat)) + (do r.monad + [point r.nat] + (wrap (/.singleton nat.enum point)))) + +(def: #export interval + (Random (Interval Nat)) + ($_ r.either + ..inner + ..outer + ..singleton)) + +(def: boundaries + Test + (do r.monad + [bottom r.nat + top r.nat + #let [interval (/.between nat.enum bottom top)]] + ($_ _.and + (_.test "A boundary value belongs to its interval." + (and (/.within? interval bottom) + (/.within? interval top))) + (_.test "An interval starts with its bottom." + (/.starts-with? bottom interval)) + (_.test "An interval ends with its top." + (/.ends-with? top interval)) + (_.test "The boundary values border the interval." + (and (/.borders? interval bottom) + (/.borders? interval top))) + ))) + +(def: union + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The union of an interval to itself yields the same interval." + (_@= some-interval (/.union some-interval some-interval))) + (_.test "The union of 2 inner intervals is another inner interval." + (/.inner? (/.union left-inner right-inner))) + (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." + (if (/.overlaps? (/.complement left-outer) (/.complement right-outer)) + (/.outer? (/.union left-outer right-outer)) + (/.inner? (/.union left-outer right-outer)))) + ))) + +(def: intersection + Test + (do r.monad + [some-interval ..interval + left-inner ..inner + right-inner ..inner + left-singleton ..singleton + right-singleton ..singleton + left-outer ..outer + right-outer ..outer] + ($_ _.and + (_.test "The intersection of an interval to itself yields the same interval." + (_@= some-interval (/.intersection some-interval some-interval))) + (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." + (if (/.overlaps? left-inner right-inner) + (/.inner? (/.intersection left-inner right-inner)) + (/.outer? (/.intersection left-inner right-inner)))) + (_.test "The intersection of 2 outer intervals is another outer interval." + (/.outer? (/.intersection left-outer right-outer))) + ))) + +(def: complement + Test + (do r.monad + [some-interval ..interval] + ($_ _.and + (_.test "The complement of a complement is the same as the original." + (_@= some-interval (|> some-interval /.complement /.complement))) + (_.test "The complement of an interval does not overlap it." + (not (/.overlaps? some-interval (/.complement some-interval)))) + ))) + +(def: location + Test + (do r.monad + [[l m r] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [left (/.singleton nat.enum l) + right (/.singleton nat.enum r)]] + ($_ _.and + (_.test "'precedes?' and 'succeeds?' are symetric." + (and (/.precedes? right left) + (/.succeeds? left right))) + (_.test "Can check if an interval is before or after some element." + (and (/.before? m left) + (/.after? m right))) + ))) + +(def: touch + Test + (do r.monad + [[b t1 t2] (|> (r.set nat.hash 3 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list b t1 t2)) + [b t1 t2] + + _ + (undefined))))) + #let [int-left (/.between nat.enum t1 t2) + int-right (/.between nat.enum b t1)]] + ($_ _.and + (_.test "An interval meets another if its top is the other's bottom." + (/.meets? int-left int-right)) + (_.test "Two intervals touch one another if any one meets the other." + (/.touches? int-left int-right)) + (_.test "Can check if 2 intervals start together." + (/.starts? (/.between nat.enum b t2) + (/.between nat.enum b t1))) + (_.test "Can check if 2 intervals finish together." + (/.finishes? (/.between nat.enum b t2) + (/.between nat.enum t1 t2))) + ))) + +(def: overlap + Test + (do r.monad + [some-interval ..interval + [x0 x1 x2 x3] (|> (r.set nat.hash 4 r.nat) + (:: @ map (|>> set.to-list + (list.sort n/<) + (case> (^ (list x0 x1 x2 x3)) + [x0 x1 x2 x3] + + _ + (undefined)))))] + ($_ _.and + (_.test "Every interval is nested into itself." + (/.nested? some-interval some-interval)) + (_.test "No interval overlaps with itself." + (not (/.overlaps? some-interval some-interval))) + (let [small-inner (/.between nat.enum x1 x2) + large-inner (/.between nat.enum x0 x3)] + (_.test "Inner intervals can be nested inside one another." + (and (/.nested? large-inner small-inner) + (not (/.nested? small-inner large-inner))))) + (let [left-inner (/.between nat.enum x0 x2) + right-inner (/.between nat.enum x1 x3)] + (_.test "Inner intervals can overlap one another." + (and (/.overlaps? left-inner right-inner) + (/.overlaps? right-inner left-inner)))) + (let [small-outer (/.between nat.enum x2 x1) + large-outer (/.between nat.enum x3 x0)] + (_.test "Outer intervals can be nested inside one another." + (and (/.nested? small-outer large-outer) + (not (/.nested? large-outer small-outer))))) + (let [left-inner (/.between nat.enum x0 x1) + right-inner (/.between nat.enum x2 x3) + outer (/.between nat.enum x0 x3)] + (_.test "Inners can be nested inside outers." + (and (/.nested? outer left-inner) + (/.nested? outer right-inner)))) + (let [left-inner (/.between nat.enum x0 x2) + right-inner (/.between nat.enum x1 x3) + outer (/.between nat.enum x1 x2)] + (_.test "Inners can overlap outers." + (and (/.overlaps? outer left-inner) + (/.overlaps? outer right-inner)))) + ))) + +(def: #export test + Test + (<| (_.context (%name (name-of /.Interval))) + ($_ _.and + ($equivalence.spec /.equivalence ..interval) + (<| (_.context "Boundaries.") + ..boundaries) + (<| (_.context "Union.") + ..union) + (<| (_.context "Intersection.") + ..intersection) + (<| (_.context "Complement.") + ..complement) + (<| (_.context "Positioning/location.") + ..location) + (<| (_.context "Touching intervals.") + ..touch) + (<| (_.context "Nesting & overlap.") + ..overlap) + ))) + +(def: #export (spec (^open "_@.") gen-sample) + (All [a] (-> (Interval a) (Random a) Test)) + (<| (_.context (%name (name-of /.Interval))) + (do r.monad + [sample gen-sample] + ($_ _.and + (_.test "No value is bigger than the top." + (_@< _@top sample)) + (_.test "No value is smaller than the bottom." + (_@> _@bottom sample)) + )))) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux new file mode 100644 index 000000000..4382a260d --- /dev/null +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -0,0 +1,58 @@ +(.module: + [lux #* + [data + [text + format]] + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ Monad do)]} + [// + [functor (#+ Injection Comparison)]]) + +(def: (left-identity injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (do r.monad + [sample r.nat + morphism (:: @ map (function (_ diff) + (|>> (n/+ diff) _;wrap)) + r.nat)] + (_.test "Left identity." + ((comparison n/=) + (|> (injection sample) (_;map morphism) _;join) + (morphism sample))))) + +(def: (right-identity injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (do r.monad + [sample r.nat] + (_.test "Right identity." + ((comparison n/=) + (|> (injection sample) (_;map _;wrap) _;join) + (injection sample))))) + +(def: (associativity injection comparison (^open "_;.")) + (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map (function (_ diff) + (|>> (n/+ diff) _;wrap)) + r.nat) + decrease (:: @ map (function (_ diff) + (|>> (n/- diff) _;wrap)) + r.nat)] + (_.test "Associativity." + ((comparison n/=) + (|> (injection sample) (_;map increase) _;join (_;map decrease) _;join) + (|> (injection sample) (_;map (|>> increase (_;map decrease) _;join)) _;join))))) + +(def: #export (spec injection comparison monad) + (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) + (_.context (%name (name-of /.Monad)) + ($_ _.and + (..left-identity injection comparison monad) + (..right-identity injection comparison monad) + (..associativity injection comparison monad) + ))) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux new file mode 100644 index 000000000..b526c3e58 --- /dev/null +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -0,0 +1,24 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + ["." function] + [abstract/monad (#+ do)] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Monoid) + [// + [equivalence (#+ Equivalence)]]]}) + +(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) + (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) + (do r.monad + [sample gen-sample] + (<| (_.context (%name (name-of /.Monoid))) + ($_ _.and + (_.test "Left identity." + (/@= sample (/@compose /@identity sample))) + (_.test "Right identity." + (/@= sample (/@compose sample /@identity))) + )))) diff --git a/stdlib/source/test/lux/abstract/number.lux b/stdlib/source/test/lux/abstract/number.lux new file mode 100644 index 000000000..2d726dfed --- /dev/null +++ b/stdlib/source/test/lux/abstract/number.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [data + [text + format]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Number) + [// + [order (#+ Order)]]]}) + +(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) + (All [a] (-> (Order a) (Number a) (Random a) Test)) + (do r.monad + [#let [non-zero (r.filter (function (_ sample) + (|> sample (/@+ sample) (/@= sample) not)) + gen-sample)] + parameter non-zero + subject non-zero] + (<| (_.context (%name (name-of /.Number))) + ($_ _.and + (_.test "Addition and subtraction are inverse functions." + (|> subject (/@+ parameter) (/@- parameter) (/@= subject))) + (_.test "Multiplication and division are inverse functions." + (|> subject (/@* parameter) (/@/ parameter) (/@= subject))) + (_.test "Modulus fills all the information division misses." + (let [modulus (/@% parameter subject) + multiple (/@- modulus subject) + factor (/@/ parameter multiple)] + (|> parameter (/@* factor) (/@+ modulus) (/@= subject)))) + (_.test "Negation flips the sign of a number and mimics subtraction." + (let [unsigned? (/@= (/@signum parameter) + (/@signum (/@negate parameter)))] + (or unsigned? + (/@= (/@+ (/@negate parameter) subject) + (/@- parameter subject))))) + (_.test "The absolute value is always positive." + (let [unsigned? (/@= parameter + (/@negate parameter))] + (if unsigned? + (/@= subject (/@abs subject)) + (/@>= subject (/@abs subject))))) + )))) diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux new file mode 100644 index 000000000..535d774a7 --- /dev/null +++ b/stdlib/source/test/lux/abstract/order.lux @@ -0,0 +1,26 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [data + [text + format]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Order)]}) + +(def: #export (spec (^open ",@.") generator) + (All [a] (-> (Order a) (Random a) Test)) + (do r.monad + [left generator + right generator] + (<| (_.context (%name (name-of /.Order))) + ($_ _.and + (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." + (if (,@= left right) + (not (or (,@< left right) + (,@> left right))) + (if (,@< left right) + (not (,@> left right)) + (,@> left right)))))))) diff --git a/stdlib/source/test/lux/cli.lux b/stdlib/source/test/lux/cli.lux index 361b447ee..ff7a3abb3 100644 --- a/stdlib/source/test/lux/cli.lux +++ b/stdlib/source/test/lux/cli.lux @@ -1,10 +1,10 @@ (.module: [lux #* data/text/format + ["M" abstract/monad (#+ Monad do)] ["_" test (#+ Test)] ["r" math/random] [control - ["M" monad (#+ Monad do)] pipe ["p" parser]] [data diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 912729c42..341a119fe 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -4,7 +4,6 @@ ["." / #_ ["#." continuation] ["#." exception] - ["#." interval] ["#." parser] ["#." pipe] ["#." reader] @@ -44,7 +43,6 @@ ($_ _.and /continuation.test /exception.test - /interval.test /parser.test (<| (_.context "/pipe") /pipe.test) diff --git a/stdlib/source/test/lux/control/apply.lux b/stdlib/source/test/lux/control/apply.lux deleted file mode 100644 index 881e5d127..000000000 --- a/stdlib/source/test/lux/control/apply.lux +++ /dev/null @@ -1,72 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - [text - format]] - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ Apply)]} - [// - [functor (#+ Injection Comparison)]]) - -(def: (identity injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] - (_.test "Identity." - ((comparison n/=) - (_;apply (injection function.identity) sample) - sample)))) - -(def: (homomorphism injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Homomorphism." - ((comparison n/=) - (_;apply (injection increase) (injection sample)) - (injection (increase sample)))))) - -(def: (interchange injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Interchange." - ((comparison n/=) - (_;apply (injection increase) (injection sample)) - (_;apply (injection (function (_ f) (f sample))) (injection increase)))))) - -(def: (composition injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat) - decrease (:: @ map n/- r.nat)] - (_.test "Composition." - ((comparison n/=) - (_$ _;apply - (injection function.compose) - (injection increase) - (injection decrease) - (injection sample)) - ($_ _;apply - (injection increase) - (injection decrease) - (injection sample)))))) - -(def: #export (spec injection comparison apply) - (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (_.context (%name (name-of /.Apply)) - ($_ _.and - (..identity injection comparison apply) - (..homomorphism injection comparison apply) - (..interchange injection comparison apply) - (..composition injection comparison apply) - ))) diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux deleted file mode 100644 index f8159838b..000000000 --- a/stdlib/source/test/lux/control/codec.lux +++ /dev/null @@ -1,27 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [control - [monad (#+ do)]] - [data - text/format - ["." error]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Codec) - [// - [equivalence (#+ Equivalence)]]]}) - -(def: #export (spec (^open "/@.") (^open "/@.") generator) - (All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test)) - (do r.monad - [expected generator] - (<| (_.context (%name (name-of /.Codec))) - (_.test "Isomorphism." - (case (|> expected /@encode /@decode) - (#error.Success actual) - (/@= expected actual) - - (#error.Failure error) - false))))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 014e4d758..eff4d051d 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -2,8 +2,8 @@ [lux #* ["_" test (#+ Test)] ["." io (#+ IO io)] + [abstract/monad (#+ do)] [control - ["M" monad (#+ do Monad)] ["ex" exception] [concurrency ["." promise ("#;." monad)]]] diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index 29cc28ad4..455f8b00d 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -2,8 +2,7 @@ [lux #* ["_" test (#+ Test)] ["." io] - [control - [monad (#+ do)]] + [abstract/monad (#+ do)] data/text/format [math ["r" random]]] diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 92e4838a8..7ac79b465 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -2,8 +2,8 @@ [lux #* ["_" test (#+ Test)] ["." io (#+ IO io)] + [abstract/monad (#+ do)] [control - ["." monad (#+ do)] [concurrency ["." promise ("#@." monad)] ["." atom (#+ Atom atom)]]] diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 952e8fb7a..5a49f26fe 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -2,8 +2,8 @@ [lux #* ["_" test (#+ Test)] ["." io] + [abstract/monad (#+ do)] [control - [monad (#+ Monad do)] pipe] data/text/format [math diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 4aa4b08a5..40bd81364 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -1,7 +1,8 @@ (.module: [lux #* + [abstract + ["." monad (#+ do)]] [control - ["." monad (#+ do)] [concurrency ["/" semaphore] ["." promise (#+ Promise)] diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 52107f6fe..9e3b9290c 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -2,8 +2,8 @@ [lux #* ["_" test (#+ Test)] ["." io (#+ IO)] + ["M" abstract/monad (#+ do Monad)] [control - ["M" monad (#+ do Monad)] [concurrency ["." atom (#+ Atom atom)] ["." process] diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index b676c67ff..571225ecc 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/control/enum.lux b/stdlib/source/test/lux/control/enum.lux deleted file mode 100644 index 5c7832260..000000000 --- a/stdlib/source/test/lux/control/enum.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux #* - data/text/format - ["_" test (#+ Test)] - ["." function] - [control - [monad (#+ do)]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Enum)]}) - -(def: #export (spec (^open "/@.") gen-sample) - (All [a] (-> (Enum a) (Random a) Test)) - (do r.monad - [sample gen-sample] - (<| (_.context (%name (name-of /.Order))) - ($_ _.and - (_.test "Successor and predecessor are inverse functions." - (and (/@= (|> sample /@succ /@pred) - (function.identity sample)) - (/@= (|> sample /@pred /@succ) - (function.identity sample)) - (not (/@= (|> sample /@succ) - (function.identity sample))) - (not (/@= (|> sample /@pred) - (function.identity sample))))) - )))) diff --git a/stdlib/source/test/lux/control/equivalence.lux b/stdlib/source/test/lux/control/equivalence.lux deleted file mode 100644 index 3e3b91a04..000000000 --- a/stdlib/source/test/lux/control/equivalence.lux +++ /dev/null @@ -1,26 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [control - [monad (#+ do)]] - [data - [text - format]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Equivalence)]}) - -(def: #export (spec (^open "_@.") generator) - (All [a] (-> (Equivalence a) (Random a) Test)) - (do r.monad - [left generator - right generator] - (<| (_.context (%name (name-of /.Equivalence))) - ($_ _.and - (_.test "Reflexivity." - (_@= left left)) - (_.test "Symmetry." - (if (_@= left right) - (_@= right left) - (not (_@= right left)))))))) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index c56688af3..7b7d90dbf 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -1,7 +1,6 @@ (.module: [lux #* - [control - [monad (#+ do)]] + [abstract/monad (#+ do)] [data [text format]] diff --git a/stdlib/source/test/lux/control/fold.lux b/stdlib/source/test/lux/control/fold.lux deleted file mode 100644 index 7d7ea8d83..000000000 --- a/stdlib/source/test/lux/control/fold.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - data/text/format - ["r" math/random] - [control - [monad (#+ do)]]] - [// - [functor (#+ Injection Comparison)]] - {1 - ["." / (#+ Fold)]}) - -(def: #export (spec injection comparison (^open "/@.")) - (All [f] (-> (Injection f) (Comparison f) (Fold f) Test)) - (_.context (%name (name-of /.Fold)) - (do r.monad - [subject r.nat - parameter r.nat] - (_.test "Can fold." - (n/= (/@fold n/+ parameter (injection subject)) - (n/+ parameter subject)))))) diff --git a/stdlib/source/test/lux/control/functor.lux b/stdlib/source/test/lux/control/functor.lux deleted file mode 100644 index 68c8db55b..000000000 --- a/stdlib/source/test/lux/control/functor.lux +++ /dev/null @@ -1,58 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - data/text/format - ["r" math/random] - [control - [equivalence (#+ Equivalence)] - [monad (#+ do)]] - ["." function]] - {1 - ["." / (#+ Functor)]}) - -(type: #export (Injection f) - (All [a] (-> a (f a)))) - -(type: #export (Comparison f) - (All [a] - (-> (Equivalence a) - (Equivalence (f a))))) - -(def: (identity injection comparison (^open "/@.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] - (_.test "Identity." - ((comparison n/=) - (/@map function.identity sample) - sample)))) - -(def: (homomorphism injection comparison (^open "/@.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Homomorphism." - ((comparison n/=) - (/@map increase (injection sample)) - (injection (increase sample)))))) - -(def: (composition injection comparison (^open "/@.")) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample (:: @ map injection r.nat) - increase (:: @ map n/+ r.nat) - decrease (:: @ map n/- r.nat)] - (_.test "Composition." - ((comparison n/=) - (|> sample (/@map increase) (/@map decrease)) - (|> sample (/@map (|>> increase decrease))))))) - -(def: #export (spec injection comparison functor) - (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (_.context (%name (name-of /.Functor)) - ($_ _.and - (..identity injection comparison functor) - (..homomorphism injection comparison functor) - (..composition injection comparison functor) - ))) diff --git a/stdlib/source/test/lux/control/interval.lux b/stdlib/source/test/lux/control/interval.lux deleted file mode 100644 index 7502f88bc..000000000 --- a/stdlib/source/test/lux/control/interval.lux +++ /dev/null @@ -1,249 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [control - [pipe (#+ case>)] - [monad (#+ do)]] - [data - [number - ["." nat]] - [text - format] - [collection - ["." set] - ["." list]]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Interval) ("_@." equivalence)]} - {0 - [test - [lux - [control - ["$." equivalence]]]]}) - -(template [ ] - [(def: #export - (Random (Interval Nat)) - (do r.monad - [bottom r.nat - top (|> r.nat (r.filter (|>> (n/= bottom) not)))] - (if ( top bottom) - (wrap (/.between nat.enum bottom top)) - (wrap (/.between nat.enum top bottom)))))] - - [inner n/<] - [outer n/>] - ) - -(def: #export singleton - (Random (Interval Nat)) - (do r.monad - [point r.nat] - (wrap (/.singleton nat.enum point)))) - -(def: #export interval - (Random (Interval Nat)) - ($_ r.either - ..inner - ..outer - ..singleton)) - -(def: boundaries - Test - (do r.monad - [bottom r.nat - top r.nat - #let [interval (/.between nat.enum bottom top)]] - ($_ _.and - (_.test "A boundary value belongs to its interval." - (and (/.within? interval bottom) - (/.within? interval top))) - (_.test "An interval starts with its bottom." - (/.starts-with? bottom interval)) - (_.test "An interval ends with its top." - (/.ends-with? top interval)) - (_.test "The boundary values border the interval." - (and (/.borders? interval bottom) - (/.borders? interval top))) - ))) - -(def: union - Test - (do r.monad - [some-interval ..interval - left-inner ..inner - right-inner ..inner - left-singleton ..singleton - right-singleton ..singleton - left-outer ..outer - right-outer ..outer] - ($_ _.and - (_.test "The union of an interval to itself yields the same interval." - (_@= some-interval (/.union some-interval some-interval))) - (_.test "The union of 2 inner intervals is another inner interval." - (/.inner? (/.union left-inner right-inner))) - (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (/.overlaps? (/.complement left-outer) (/.complement right-outer)) - (/.outer? (/.union left-outer right-outer)) - (/.inner? (/.union left-outer right-outer)))) - ))) - -(def: intersection - Test - (do r.monad - [some-interval ..interval - left-inner ..inner - right-inner ..inner - left-singleton ..singleton - right-singleton ..singleton - left-outer ..outer - right-outer ..outer] - ($_ _.and - (_.test "The intersection of an interval to itself yields the same interval." - (_@= some-interval (/.intersection some-interval some-interval))) - (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (/.overlaps? left-inner right-inner) - (/.inner? (/.intersection left-inner right-inner)) - (/.outer? (/.intersection left-inner right-inner)))) - (_.test "The intersection of 2 outer intervals is another outer interval." - (/.outer? (/.intersection left-outer right-outer))) - ))) - -(def: complement - Test - (do r.monad - [some-interval ..interval] - ($_ _.and - (_.test "The complement of a complement is the same as the original." - (_@= some-interval (|> some-interval /.complement /.complement))) - (_.test "The complement of an interval does not overlap it." - (not (/.overlaps? some-interval (/.complement some-interval)))) - ))) - -(def: location - Test - (do r.monad - [[l m r] (|> (r.set nat.hash 3 r.nat) - (:: @ map (|>> set.to-list - (list.sort n/<) - (case> (^ (list b t1 t2)) - [b t1 t2] - - _ - (undefined))))) - #let [left (/.singleton nat.enum l) - right (/.singleton nat.enum r)]] - ($_ _.and - (_.test "'precedes?' and 'succeeds?' are symetric." - (and (/.precedes? right left) - (/.succeeds? left right))) - (_.test "Can check if an interval is before or after some element." - (and (/.before? m left) - (/.after? m right))) - ))) - -(def: touch - Test - (do r.monad - [[b t1 t2] (|> (r.set nat.hash 3 r.nat) - (:: @ map (|>> set.to-list - (list.sort n/<) - (case> (^ (list b t1 t2)) - [b t1 t2] - - _ - (undefined))))) - #let [int-left (/.between nat.enum t1 t2) - int-right (/.between nat.enum b t1)]] - ($_ _.and - (_.test "An interval meets another if its top is the other's bottom." - (/.meets? int-left int-right)) - (_.test "Two intervals touch one another if any one meets the other." - (/.touches? int-left int-right)) - (_.test "Can check if 2 intervals start together." - (/.starts? (/.between nat.enum b t2) - (/.between nat.enum b t1))) - (_.test "Can check if 2 intervals finish together." - (/.finishes? (/.between nat.enum b t2) - (/.between nat.enum t1 t2))) - ))) - -(def: overlap - Test - (do r.monad - [some-interval ..interval - [x0 x1 x2 x3] (|> (r.set nat.hash 4 r.nat) - (:: @ map (|>> set.to-list - (list.sort n/<) - (case> (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined)))))] - ($_ _.and - (_.test "Every interval is nested into itself." - (/.nested? some-interval some-interval)) - (_.test "No interval overlaps with itself." - (not (/.overlaps? some-interval some-interval))) - (let [small-inner (/.between nat.enum x1 x2) - large-inner (/.between nat.enum x0 x3)] - (_.test "Inner intervals can be nested inside one another." - (and (/.nested? large-inner small-inner) - (not (/.nested? small-inner large-inner))))) - (let [left-inner (/.between nat.enum x0 x2) - right-inner (/.between nat.enum x1 x3)] - (_.test "Inner intervals can overlap one another." - (and (/.overlaps? left-inner right-inner) - (/.overlaps? right-inner left-inner)))) - (let [small-outer (/.between nat.enum x2 x1) - large-outer (/.between nat.enum x3 x0)] - (_.test "Outer intervals can be nested inside one another." - (and (/.nested? small-outer large-outer) - (not (/.nested? large-outer small-outer))))) - (let [left-inner (/.between nat.enum x0 x1) - right-inner (/.between nat.enum x2 x3) - outer (/.between nat.enum x0 x3)] - (_.test "Inners can be nested inside outers." - (and (/.nested? outer left-inner) - (/.nested? outer right-inner)))) - (let [left-inner (/.between nat.enum x0 x2) - right-inner (/.between nat.enum x1 x3) - outer (/.between nat.enum x1 x2)] - (_.test "Inners can overlap outers." - (and (/.overlaps? outer left-inner) - (/.overlaps? outer right-inner)))) - ))) - -(def: #export test - Test - (<| (_.context (%name (name-of /.Interval))) - ($_ _.and - ($equivalence.spec /.equivalence ..interval) - (<| (_.context "Boundaries.") - ..boundaries) - (<| (_.context "Union.") - ..union) - (<| (_.context "Intersection.") - ..intersection) - (<| (_.context "Complement.") - ..complement) - (<| (_.context "Positioning/location.") - ..location) - (<| (_.context "Touching intervals.") - ..touch) - (<| (_.context "Nesting & overlap.") - ..overlap) - ))) - -(def: #export (spec (^open "_@.") gen-sample) - (All [a] (-> (Interval a) (Random a) Test)) - (<| (_.context (%name (name-of /.Interval))) - (do r.monad - [sample gen-sample] - ($_ _.and - (_.test "No value is bigger than the top." - (_@< _@top sample)) - (_.test "No value is smaller than the bottom." - (_@> _@bottom sample)) - )))) diff --git a/stdlib/source/test/lux/control/monad.lux b/stdlib/source/test/lux/control/monad.lux deleted file mode 100644 index 4382a260d..000000000 --- a/stdlib/source/test/lux/control/monad.lux +++ /dev/null @@ -1,58 +0,0 @@ -(.module: - [lux #* - [data - [text - format]] - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ Monad do)]} - [// - [functor (#+ Injection Comparison)]]) - -(def: (left-identity injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat - morphism (:: @ map (function (_ diff) - (|>> (n/+ diff) _;wrap)) - r.nat)] - (_.test "Left identity." - ((comparison n/=) - (|> (injection sample) (_;map morphism) _;join) - (morphism sample))))) - -(def: (right-identity injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat] - (_.test "Right identity." - ((comparison n/=) - (|> (injection sample) (_;map _;wrap) _;join) - (injection sample))))) - -(def: (associativity injection comparison (^open "_;.")) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map (function (_ diff) - (|>> (n/+ diff) _;wrap)) - r.nat) - decrease (:: @ map (function (_ diff) - (|>> (n/- diff) _;wrap)) - r.nat)] - (_.test "Associativity." - ((comparison n/=) - (|> (injection sample) (_;map increase) _;join (_;map decrease) _;join) - (|> (injection sample) (_;map (|>> increase (_;map decrease) _;join)) _;join))))) - -(def: #export (spec injection comparison monad) - (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (_.context (%name (name-of /.Monad)) - ($_ _.and - (..left-identity injection comparison monad) - (..right-identity injection comparison monad) - (..associativity injection comparison monad) - ))) diff --git a/stdlib/source/test/lux/control/monoid.lux b/stdlib/source/test/lux/control/monoid.lux deleted file mode 100644 index b12262900..000000000 --- a/stdlib/source/test/lux/control/monoid.lux +++ /dev/null @@ -1,25 +0,0 @@ -(.module: - [lux #* - data/text/format - ["_" test (#+ Test)] - ["." function] - [control - [monad (#+ do)]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Monoid) - [// - [equivalence (#+ Equivalence)]]]}) - -(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) - (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) - (do r.monad - [sample gen-sample] - (<| (_.context (%name (name-of /.Monoid))) - ($_ _.and - (_.test "Left identity." - (/@= sample (/@compose /@identity sample))) - (_.test "Right identity." - (/@= sample (/@compose sample /@identity))) - )))) diff --git a/stdlib/source/test/lux/control/number.lux b/stdlib/source/test/lux/control/number.lux deleted file mode 100644 index 57bee6ee3..000000000 --- a/stdlib/source/test/lux/control/number.lux +++ /dev/null @@ -1,47 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [control - [monad (#+ do)]] - [data - [text - format]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Number) - [// - [order (#+ Order)]]]}) - -(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) - (All [a] (-> (Order a) (Number a) (Random a) Test)) - (do r.monad - [#let [non-zero (r.filter (function (_ sample) - (|> sample (/@+ sample) (/@= sample) not)) - gen-sample)] - parameter non-zero - subject non-zero] - (<| (_.context (%name (name-of /.Number))) - ($_ _.and - (_.test "Addition and subtraction are inverse functions." - (|> subject (/@+ parameter) (/@- parameter) (/@= subject))) - (_.test "Multiplication and division are inverse functions." - (|> subject (/@* parameter) (/@/ parameter) (/@= subject))) - (_.test "Modulus fills all the information division misses." - (let [modulus (/@% parameter subject) - multiple (/@- modulus subject) - factor (/@/ parameter multiple)] - (|> parameter (/@* factor) (/@+ modulus) (/@= subject)))) - (_.test "Negation flips the sign of a number and mimics subtraction." - (let [unsigned? (/@= (/@signum parameter) - (/@signum (/@negate parameter)))] - (or unsigned? - (/@= (/@+ (/@negate parameter) subject) - (/@- parameter subject))))) - (_.test "The absolute value is always positive." - (let [unsigned? (/@= parameter - (/@negate parameter))] - (if unsigned? - (/@= subject (/@abs subject)) - (/@>= subject (/@abs subject))))) - )))) diff --git a/stdlib/source/test/lux/control/order.lux b/stdlib/source/test/lux/control/order.lux deleted file mode 100644 index f18d110c2..000000000 --- a/stdlib/source/test/lux/control/order.lux +++ /dev/null @@ -1,27 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [control - [monad (#+ do)]] - [data - [text - format]] - [math - ["r" random (#+ Random)]]] - {1 - ["." / (#+ Order)]}) - -(def: #export (spec (^open ",@.") generator) - (All [a] (-> (Order a) (Random a) Test)) - (do r.monad - [left generator - right generator] - (<| (_.context (%name (name-of /.Order))) - ($_ _.and - (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (if (,@= left right) - (not (or (,@< left right) - (,@> left right))) - (if (,@< left right) - (not (,@> left right)) - (,@> left right)))))))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index a5d8fb0c2..da6c0a381 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] [equivalence (#+ Equivalence)] {[0 #test] diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index fda914291..6f7b65a53 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)]] [data ["." identity] diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 59763c0e8..aa639ce70 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -2,7 +2,7 @@ [lux #* ["." io (#+ IO)] ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index cca103eac..a575e4250 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -1,8 +1,9 @@ (.module: [lux #* ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] [control - ["." monad (#+ do)] ["." thread (#+ Thread)] ["ex" exception (#+ exception:)]] [data diff --git a/stdlib/source/test/lux/control/security/integrity.lux b/stdlib/source/test/lux/control/security/integrity.lux index ad9b67f4f..77e0505d6 100644 --- a/stdlib/source/test/lux/control/security/integrity.lux +++ b/stdlib/source/test/lux/control/security/integrity.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [hash (#+ Hash)] [monad (#+ do)] {[0 #test] diff --git a/stdlib/source/test/lux/control/security/privacy.lux b/stdlib/source/test/lux/control/security/privacy.lux index 3bc41e6a9..3b167e0d2 100644 --- a/stdlib/source/test/lux/control/security/privacy.lux +++ b/stdlib/source/test/lux/control/security/privacy.lux @@ -1,16 +1,17 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [hash (#+ Hash)] [monad (#+ do)] - [security - ["!" capability]] {[0 #test] [/ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] + [control + [security + ["!" capability]]] [data ["." text ("#;." equivalence) format]] diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 8bae5e472..808d5ebb2 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -2,14 +2,15 @@ [lux #* ["_" test (#+ Test)] ["." io] - [control - [pipe (#+ let>)] + [abstract [monad (#+ do)] {[0 #test] [/ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] + [control + [pipe (#+ let>)]] [data ["." product] [text diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index a6f28e428..56d3a7d5c 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index dfd3b4a10..392fc7a4b 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -2,7 +2,7 @@ [lux #* ["_" test (#+ Test)] ["." io] - [control + [abstract [equivalence (#+ Equivalence)] [monoid (#+ Monoid)] [monad (#+ do)] diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index f6ad5e727..9515fa5ce 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -4,7 +4,7 @@ ["_" test (#+ Test)] ["r" math/random] ["." function] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 8814a6e88..c210a9163 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -2,8 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ do Monad)] {[0 #test] [/ @@ -11,6 +10,8 @@ ["$." monoid] ["$." fold] ["$." functor (#+ Injection)]]}] + [control + pipe] [data ["." maybe] [number diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index ac7e983f9..a727761ca 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] ["." predicate] {[0 #test] diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index e559a2453..863c47973 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] ["eq" equivalence] {[0 #test] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 4cd7880ba..57dab9884 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] [equivalence (#+ Equivalence)] [order (#+ Order)] diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 958025e8b..247b2de78 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -3,8 +3,7 @@ data/text/format ["_" test (#+ Test)] ["." io] - [control - pipe + [abstract [monad (#+ do)] {[0 #test] [/ @@ -14,6 +13,8 @@ ["$." functor] ["$." apply] ["$." monad]]}] + [control + pipe] [data ["." bit] ["." product] diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index c377fccc3..506cf15e3 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index df24b8368..4c4f2923a 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract ["." monad (#+ do)]] [data ["." maybe] diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 1fa55e135..15085776b 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index edacef996..6b4529dfc 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -2,9 +2,9 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract comonad - [monad (#+ do Monad)]] + [monad (#+ do)]] [data ["." maybe] [number diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index f319af295..f272cf305 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 7f143a9cd..4bddfaf33 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] [order (#+ Order)] {[0 #test] diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 2886fa815..05b8efc47 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux index 987a72f45..65b46e382 100644 --- a/stdlib/source/test/lux/data/collection/tree/rose.lux +++ b/stdlib/source/test/lux/data/collection/tree/rose.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux index 3a3bd296c..e8f59a43a 100644 --- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux @@ -2,8 +2,8 @@ [lux #* data/text/format ["_" test (#+ Test)] + [abstract/monad (#+ do Monad)] [control - [monad (#+ do Monad)] pipe] [data ["." maybe] diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index f3db0c6f7..a8a61cb46 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux index c60c6563a..8f89ccb8f 100644 --- a/stdlib/source/test/lux/data/error.lux +++ b/stdlib/source/test/lux/data/error.lux @@ -2,8 +2,7 @@ [lux #* ["_" test (#+ Test)] ["." io] - [control - pipe + [abstract [monad (#+ do Monad)] {[0 #test] [/ @@ -11,6 +10,8 @@ ["$." apply] ["$." monad] ["$." equivalence]]}] + [control + pipe] [data text/format [number diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index f276c5180..c2826143a 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -2,16 +2,17 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract codec [monad (#+ do Monad)] [equivalence (#+ Equivalence)] - ["p" parser] {[0 #test] [/ ["$." equivalence] ["$." codec]]}] + [control + pipe + ["p" parser]] [data ["." error] ["." bit] diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 221edba97..cf2b10f65 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -2,14 +2,15 @@ [lux (#- char) data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ Monad do)] - ["p" parser] {[0 #test] [/ ["$." equivalence] ["$." codec]]}] + [control + pipe + ["p" parser]] [data ["." name] ["E" error] diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index ef4450c50..38d20a7d5 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract comonad [monad (#+ do)] {[0 #test] diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index 44c0ff2da..62b1273e4 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index 4aa89f85f..dc6ca1d56 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -1,8 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ do)] {[0 #test] [/ @@ -10,6 +9,8 @@ ["$." functor] ["$." apply] ["$." monad]]}] + [control + pipe] [data ["." text format] diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index a42684938..d9ee517d0 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -1,13 +1,14 @@ (.module: [lux #* ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ do)] {[0 #test] [/ ["$." equivalence] ["$." codec]]}] + [control + pipe] [data ["." text ("#@." equivalence) format]] diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index a1fc7beca..8eed3e865 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index 89ff72749..544ab858c 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 3e251d1e6..1519b1e48 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux index e11685580..5b0d523ae 100644 --- a/stdlib/source/test/lux/data/number/int.lux +++ b/stdlib/source/test/lux/data/number/int.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux index 9616e9bd6..4c46b4b0c 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index c3c67c317..f0ce55751 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 15b98ffe6..308861368 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index e3166dcd9..20ad838b7 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -2,13 +2,14 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ do Monad)] {[0 #test] [/ ["$." equivalence] ["$." order]]}] + [control + pipe] [data [collection ["." list]]] diff --git a/stdlib/source/test/lux/data/text/lexer.lux b/stdlib/source/test/lux/data/text/lexer.lux index b15a86846..3693b0fd0 100644 --- a/stdlib/source/test/lux/data/text/lexer.lux +++ b/stdlib/source/test/lux/data/text/lexer.lux @@ -2,9 +2,9 @@ [lux #* data/text/format ["_" test (#+ Test)] + [abstract/monad (#+ do)] [control pipe - [monad (#+ do Monad)] ["p" parser]] [data ["." error (#+ Error)] diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 059adff84..58ef21b8b 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -2,8 +2,8 @@ [lux #* data/text/format ["_" test (#+ Test)] + [abstract/monad (#+ do)] [control - [monad (#+ do Monad)] pipe ["p" parser]] [data diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index 9bd0f5399..04c149881 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -1,7 +1,7 @@ (.module: [lux #* + [abstract/monad (#+ Monad do)] [control - [monad (#+ Monad do)] pipe] [data ["." text ("#;." equivalence)]] diff --git a/stdlib/source/test/lux/host/jvm.jvm.lux b/stdlib/source/test/lux/host/jvm.jvm.lux index b0655ebd3..16c4aea90 100644 --- a/stdlib/source/test/lux/host/jvm.jvm.lux +++ b/stdlib/source/test/lux/host/jvm.jvm.lux @@ -1,7 +1,7 @@ (.module: [lux #* + [abstract/monad (#+ do)] [control - [monad (#+ do)] [concurrency ["." atom]] [security diff --git a/stdlib/source/test/lux/io.lux b/stdlib/source/test/lux/io.lux index 504c9bb9c..3b00ceb3f 100644 --- a/stdlib/source/test/lux/io.lux +++ b/stdlib/source/test/lux/io.lux @@ -3,7 +3,7 @@ data/text/format ["_" test (#+ Test)] ["r" math/random] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index d7389dd20..acd4bcdac 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)]] {1 diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index c400bf206..c8d0b8077 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] [data diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 41ae1ecd0..4024d0a89 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -3,8 +3,8 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)]] - [control + [abstract/monad (#+ do)] + [abstract [equivalence (#+ Equivalence)]] [data ["." bit] diff --git a/stdlib/source/test/lux/macro/poly/functor.lux b/stdlib/source/test/lux/macro/poly/functor.lux index 5b477682d..7f47148ab 100644 --- a/stdlib/source/test/lux/macro/poly/functor.lux +++ b/stdlib/source/test/lux/macro/poly/functor.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 2669b9801..1209aa90a 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -2,16 +2,17 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract codec [monad (#+ do Monad)] [equivalence (#+ Equivalence)] - ["p" parser] {[0 #test] [/ ["$." equivalence] ["$." codec]]}] + [control + pipe + ["p" parser]] [data ["." error] ["." bit] diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 60dd38b6e..92ba86d4d 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -1,11 +1,12 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] + [abstract + [equivalence (#+ Equivalence)]] [control - [equivalence (#+ Equivalence)] ["p" parser]] [data ["." bit] diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index a659e8095..fcd4a1134 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -3,8 +3,7 @@ data/text/format ["_" test (#+ Test)] ["r" math/random (#+ Random)] - [control - [monad (#+ Monad do)]] + [abstract/monad (#+ Monad do)] [data ["." bit ("#@." equivalence)] [number diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index 59a44022a..db40f693c 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random] ["_" test (#+ Test)] [data diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux index 214a3c041..82ad36be0 100644 --- a/stdlib/source/test/lux/math/logic/continuous.lux +++ b/stdlib/source/test/lux/math/logic/continuous.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random] ["_" test (#+ Test)]] {1 diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index e75268bf0..10b75195a 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -1,7 +1,7 @@ (.module: [lux #* data/text/format - [control/monad (#+ do)] + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] [data diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 97655ee9b..5d929527e 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -3,7 +3,7 @@ data/text/format ["_" test (#+ Test)] ["r" math/random] - [control/monad (#+ do)] + [abstract/monad (#+ do)] [data ["." product] ["." bit ("#@." equivalence)] diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux index ffd055e35..483b51388 100644 --- a/stdlib/source/test/lux/time/date.lux +++ b/stdlib/source/test/lux/time/date.lux @@ -3,7 +3,8 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)] + [abstract + ["." monad (#+ do)] {[0 #test] [/ ["$." equivalence] diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index 84d404a21..4df0ad30b 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract {[0 #test] [/ ["$." equivalence] diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index a7265f62f..e63397b32 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract [monad (#+ do)] {[0 #test] [/ diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 9b903d993..24f7e7962 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -2,8 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control - pipe + [abstract [monad (#+ do Monad)] {[0 #test] [/ @@ -11,6 +10,8 @@ ["$." order] ["$." enum] ["$." codec]]}] + [control + pipe] [data ["." text]] [math diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index f0722af0b..7b0cb43d2 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -2,7 +2,7 @@ [lux #* data/text/format ["_" test (#+ Test)] - [control + [abstract {[0 #test] [/ ["$." equivalence] diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 96478b077..6840807f7 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -1,7 +1,7 @@ (.module: [lux (#- type) data/text/format - ["M" control/monad (#+ do)] + ["M" abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index d73b2783d..9d511d5ae 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -1,9 +1,10 @@ (.module: [lux (#- type) data/text/format - [control ["." monad (#+ do)]] ["r" math/random (#+ Random)] ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] [control [pipe (#+ case>)]] [data diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index e2564627a..4e1bea6a8 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -1,9 +1,9 @@ (.module: [lux #* data/text/format + [abstract/monad (#+ do)] ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)]] [data ["." error]]] {1 diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 5383c252f..372f544f7 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -3,8 +3,8 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)]] - [control + [abstract/monad (#+ do)] + [abstract [equivalence (#+)] [functor (#+)]] [data diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 15d7cd137..293629e18 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -3,7 +3,7 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control + [abstract [monad [indexed (#+ do)]]] ["." io]] diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux index 2e463ea4b..a9817115d 100644 --- a/stdlib/source/test/lux/world/binary.lux +++ b/stdlib/source/test/lux/world/binary.lux @@ -3,7 +3,8 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)] + [abstract + ["." monad (#+ do)] {[0 #test] [/ ["$." equivalence]]}] diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index e27add632..86b031660 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -3,8 +3,8 @@ data/text/format ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] + [abstract/monad (#+ do)] [control - ["." monad (#+ do)] [concurrency ["." promise]] [security diff --git a/stdlib/source/test/lux/world/net/tcp.lux b/stdlib/source/test/lux/world/net/tcp.lux index f7ec2eaef..b3f9a6d0d 100644 --- a/stdlib/source/test/lux/world/net/tcp.lux +++ b/stdlib/source/test/lux/world/net/tcp.lux @@ -3,7 +3,7 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] - [control ["." monad (#+ do)]] + ["." abstract/monad (#+ do)] ["." io (#+ IO)] [control ["ex" exception (#+ exception:)] diff --git a/stdlib/source/test/lux/world/net/udp.lux b/stdlib/source/test/lux/world/net/udp.lux index 1740c861c..2e61257ad 100644 --- a/stdlib/source/test/lux/world/net/udp.lux +++ b/stdlib/source/test/lux/world/net/udp.lux @@ -3,8 +3,8 @@ data/text/format ["r" math/random (#+ Random)] ["_" test (#+ Test)] + ["." abstract/monad (#+ do)] [control - ["." monad (#+ do)] [concurrency ["." promise]] [security -- cgit v1.2.3