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))
+            ))))