1 files changed, 69 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/control/apply.lux b/stdlib/source/test/lux/control/apply.lux
new file mode 100644
index 000000000..01fb33797
--- /dev/null
+++ b/stdlib/source/test/lux/control/apply.lux
@@ -0,0 +1,69 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   ["." function]
+   [math
+    ["r" random]]
+   ["_" test (#+ Test)]]
+  {1
+   ["." / (#+ Apply)]}
+  [//
+   [functor (#+ Injection Comparison)]])
+
+(def: (identity (^open "_/.") injection comparison)
+  (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample (:: @ map injection r.nat)]
+    (_.test "Identity."
+            ((comparison n/=)
+             (_/apply (injection function.identity) sample)
+             sample))))
+
+(def: (homomorphism (^open "_/.") injection comparison)
+  (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     increase (:: @ map n/+ r.nat)]
+    (_.test "Homomorphism."
+            ((comparison n/=)
+             (_/apply (injection increase) (injection sample))
+             (injection (increase sample))))))
+
+(def: (interchange (^open "_/.") injection comparison)
+  (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     increase (:: @ map n/+ r.nat)]
+    (_.test "Interchange."
+            ((comparison n/=)
+             (_/apply (injection increase) (injection sample))
+             (_/apply (injection (function (_ f) (f sample))) (injection increase))))))
+
+(def: (composition (^open "_/.") injection comparison)
+  (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     increase (:: @ map n/+ r.nat)
+     decrease (:: @ map n/- r.nat)]
+    (_.test "Composition."
+            ((comparison n/=)
+             (_$ _/apply
+                 (injection function.compose)
+                 (injection increase)
+                 (injection decrease)
+                 (injection sample))
+             ($_ _/apply
+                 (injection increase)
+                 (injection decrease)
+                 (injection sample))))))
+
+(def: #export (laws apply injection comparison)
+  (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+  (_.context "Apply laws."
+             ($_ _.and
+                 (..identity apply injection comparison)
+                 (..homomorphism apply injection comparison)
+                 (..interchange apply injection comparison)
+                 (..composition apply injection comparison)
+                 )))