1 files changed, 62 insertions, 0 deletions
diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux
new file mode 100644
index 000000000..cfa6cc2ff
--- /dev/null
+++ b/stdlib/source/specification/lux/abstract/functor.lux
@@ -0,0 +1,62 @@
+(.module:
+  [library
+   [lux #*
+    ["_" test (#+ Test)]
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [monad (#+ do)]]
+    [control
+     ["." function]]
+    [math
+     ["." random]
+     [number
+      ["n" nat]]]]]
+  [\\library
+   ["." / (#+ 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))
+  (<| (_.for [/.Functor])
+      ($_ _.and
+          (..identity injection comparison functor)
+          (..homomorphism injection comparison functor)
+          (..composition injection comparison functor)
+          )))