1 files changed, 62 insertions, 0 deletions
diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux
new file mode 100644
index 000000000..2cb086b7a
--- /dev/null
+++ b/stdlib/source/spec/lux/abstract/functor.lux
@@ -0,0 +1,62 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [control
+    ["." function]]
+   [data
+    [number
+     ["n" nat]]]
+   [math
+    ["." random]]]
+  {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 {@ random.monad}
+    [sample (:: @ map injection random.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 {@ random.monad}
+    [sample random.nat
+     increase (:: @ map n.+ random.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 {@ 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))
+             (|> sample (/@map (|>> increase decrease)))))))
+
+(def: #export (spec injection comparison functor)
+  (All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
+  (<| (_.with-cover [/.Functor])
+      ($_ _.and
+          (..identity injection comparison functor)
+          (..homomorphism injection comparison functor)
+          (..composition injection comparison functor)
+          )))