diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/test/lux/abstract/functor.lux | 84 |
1 files changed, 67 insertions, 17 deletions
diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 388a66ffc..0702f00ef 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -2,15 +2,19 @@ [lux #* ["_" test (#+ Test)] ["%" data/text/format (#+ format)] - ["r" math/random] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] [control ["." function]] [data + ["." maybe] [number - ["n" nat]]]] + ["n" nat]] + [collection + ["." list]]] + [math + ["." random]]] {1 ["." / (#+ Functor)]}) @@ -24,8 +28,8 @@ (def: (identity injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] + (do random.monad + [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) (/@map function.identity sample) @@ -33,9 +37,9 @@ (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)] + (do random.monad + [sample random.nat + increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) (/@map increase (injection sample)) @@ -43,10 +47,10 @@ (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)] + (do random.monad + [sample (:: @ map injection random.nat) + increase (:: @ map n.+ random.nat) + decrease (:: @ map n.- random.nat)] (_.test "Composition." ((comparison n.=) (|> sample (/@map increase) (/@map decrease)) @@ -54,9 +58,55 @@ (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) - ))) + (<| (_.with-cover [/.Functor]) + ($_ _.and + (..identity injection comparison functor) + (..homomorphism injection comparison functor) + (..composition injection comparison functor) + ))) + +(def: #export test + Test + (do random.monad + [left random.nat + right random.nat + shift random.nat] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.Or /.sum] + (and (case (:: (/.sum maybe.functor list.functor) map + (n.+ shift) + (#.Left (#.Some left))) + (#.Left (#.Some actual)) + (n.= (n.+ shift left) actual) + + _ + false) + (case (:: (/.sum maybe.functor list.functor) map + (n.+ shift) + (#.Right (list right))) + (^ (#.Right (list actual))) + (n.= (n.+ shift right) actual) + + _ + false))) + (_.cover [/.And /.product] + (case (:: (/.product maybe.functor list.functor) map + (n.+ shift) + [(#.Some left) (list right)]) + (^ [(#.Some actualL) (list actualR)]) + (and (n.= (n.+ shift left) actualL) + (n.= (n.+ shift right) actualR)) + + _ + false)) + (_.cover [/.Then /.compose] + (case (:: (/.compose maybe.functor list.functor) map + (n.+ shift) + (#.Some (list left))) + (^ (#.Some (list actual))) + (n.= (n.+ shift left) actual) + + _ + false)) + )))) |