diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/abstract.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/monad/free.lux | 57 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/predicate.lux | 113 |
3 files changed, 140 insertions, 51 deletions
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index aa93df86f..12c3625b3 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -8,21 +8,28 @@ ["#." enum] ["#." equivalence] ["#." fold] - ["#." functor] + ["#." functor + ["#/." contravariant]] ["#." hash] ["#." interval] - ["#." monad] + ["#." monad + ["#/." free]] ["#." monoid] ["#." order] - ["#." predicate] - [functor - ["#." contravariant]]]) + ["#." predicate]]) (def: functor Test ($_ _.and /functor.test - /contravariant.test + /functor/contravariant.test + )) + +(def: monad + Test + ($_ _.and + /monad.test + /monad/free.test )) (def: #export test @@ -37,7 +44,7 @@ ..functor /hash.test /interval.test - /monad.test + ..monad /monoid.test /order.test /predicate.test diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux new file mode 100644 index 000000000..7241dc8b9 --- /dev/null +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -0,0 +1,57 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] + [data + [collection + ["." list ("#@." functor)]]] + [math + ["." random]]] + {1 + ["." /]}) + +(def: injection + (Injection (/.Free List)) + (|>> #/.Pure)) + +(def: (interpret free) + (All [a] (-> (/.Free List a) (List a))) + (case free + (#/.Pure value) + (list value) + + (#/.Effect effect) + (|> effect + (list@map interpret) + list.concat))) + +(def: comparison + (Comparison (/.Free List)) + (function (_ == left right) + (:: (list.equivalence ==) = + (..interpret left) + (..interpret right)))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Free]) + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison (: (Functor (/.Free List)) + (/.functor list.functor)))) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison (: (Apply (/.Free List)) + (/.apply list.functor)))) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison (: (Monad (/.Free List)) + (/.monad list.functor)))) + ))) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index 3831ac0fb..1a0d457db 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -3,21 +3,25 @@ ["_" test (#+ Test)] [abstract [equivalence (#+ Equivalence)] - [monad (#+ do)]] + [monad (#+ do)] + {[0 #spec] + [/ + [functor + ["." contravariant]]]}] [control ["." function]] [data ["." bit ("#@." equivalence)] - [text - ["%" format (#+ format)]] [number - ["n" nat]]] + ["n" nat]] + [collection + ["." list]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] ["." // #_ ["#." monoid]] {1 - ["." / (#+ Predicate)]}) + ["." /]}) (def: (multiple? factor) (-> Nat (/.Predicate Nat)) @@ -27,41 +31,62 @@ (def: #export test Test - (let [/2? (multiple? 2) - /3? (multiple? 3)] - (<| (_.context (%.name (name-of /.Predicate))) - (do {@ r.monad} - [sample r.nat]) - ($_ _.and - (_.test (%.name (name-of /.none)) - (bit@= false (/.none sample))) - (_.test (%.name (name-of /.all)) - (bit@= true (/.all sample))) - (_.test (%.name (name-of /.unite)) - (bit@= (/.all sample) - ((/.unite /.none /.all) sample))) - (_.test (%.name (name-of /.intersect)) - (bit@= (/.none sample) - ((/.intersect /.none /.all) sample))) - (_.test (%.name (name-of /.complement)) - (and (not (bit@= (/.none sample) - ((/.complement /.none) sample))) - (not (bit@= (/.all sample) - ((/.complement /.all) sample))))) - (_.test (%.name (name-of /.difference)) - (bit@= (and (/2? sample) - (not (/3? sample))) - ((/.difference /3? /2?) sample))) - (let [equivalence (: (Equivalence (/.Predicate Nat)) - (structure - (def: (= left right) - (bit@= (left sample) - (right sample))))) - generator (: (Random (/.Predicate Nat)) - (|> r.nat - (r.filter (|>> (n.= 0) not)) - (:: @ map multiple?)))] - ($_ _.and - (//monoid.spec equivalence /.union generator) - (//monoid.spec equivalence /.intersection generator))) - )))) + (<| (_.covering /._) + (do {@ random.monad} + [sample random.nat + samples (random.list 10 random.nat) + #let [equivalence (: (Equivalence (/.Predicate Nat)) + (structure + (def: (= left right) + (bit@= (left sample) + (right sample)))))]]) + (_.with-cover [/.Predicate]) + ($_ _.and + (_.with-cover [/.functor] + (contravariant.spec equivalence (multiple? 2) /.functor)) + (let [generator (: (Random (/.Predicate Nat)) + (|> random.nat + (random.filter (|>> (n.= 0) not)) + (:: @ map multiple?)))] + ($_ _.and + (_.with-cover [/.union] + (//monoid.spec equivalence /.union generator)) + (_.with-cover [/.intersection] + (//monoid.spec equivalence /.intersection generator)))) + + (_.cover [/.none] + (bit@= false (/.none sample))) + (_.cover [/.all] + (bit@= true (/.all sample))) + (_.cover [/.unite] + (bit@= (/.all sample) + ((/.unite /.none /.all) sample))) + (_.cover [/.intersect] + (bit@= (/.none sample) + ((/.intersect /.none /.all) sample))) + (_.cover [/.complement] + (and (not (bit@= (/.none sample) + ((/.complement /.none) sample))) + (not (bit@= (/.all sample) + ((/.complement /.all) sample))))) + (_.cover [/.difference] + (let [/2? (multiple? 2) + /3? (multiple? 3)] + (bit@= (and (/2? sample) + (not (/3? sample))) + ((/.difference /3? /2?) sample)))) + (_.cover [/.rec] + (let [even? (multiple? 2) + any-even? (: (/.Predicate (List Nat)) + (/.rec (function (_ recur) + (function (_ values) + (case values + #.Nil + false + + (#.Cons head tail) + (or (even? head) + (recur tail)))))))] + (bit@= (list.any? even? samples) + (any-even? samples)))) + ))) |