From e3acf1b94bea5460409cbd9d7cec534f34bd9037 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 4 Feb 2019 19:39:20 -0400
Subject: Ported "lux/io" module to new test format.

---
 stdlib/test/test.lux                     |  1 -
 stdlib/test/test/lux.lux                 |  9 +++--
 stdlib/test/test/lux/control/apply.lux   | 69 ++++++++++++++++++++++++++++++++
 stdlib/test/test/lux/control/functor.lux | 56 ++++++++++++++++++++++++++
 stdlib/test/test/lux/control/monad.lux   | 54 +++++++++++++++++++++++++
 stdlib/test/test/lux/io.lux              | 55 ++++++++++++++++---------
 6 files changed, 220 insertions(+), 24 deletions(-)
 create mode 100644 stdlib/test/test/lux/control/apply.lux
 create mode 100644 stdlib/test/test/lux/control/functor.lux
 create mode 100644 stdlib/test/test/lux/control/monad.lux

diff --git a/stdlib/test/test.lux b/stdlib/test/test.lux
index 53efb1c05..a28c38ce5 100644
--- a/stdlib/test/test.lux
+++ b/stdlib/test/test.lux
@@ -83,7 +83,6 @@
   ## TODO: Must have 100% coverage on tests.
   [/
    ["/." lux
-    ## [io (#+)]
     ## [time
     ##  [instant (#+)]
     ##  [duration (#+)]
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
index 0470be339..665a11e89 100644
--- a/stdlib/test/test/lux.lux
+++ b/stdlib/test/test/lux.lux
@@ -12,6 +12,7 @@
    ["_" test (#+ Test)]]
   [/
    ["/." cli]
+   ["/." io]
    ["/." host
     ["/." jvm]]])
 
@@ -232,11 +233,13 @@
           ..template)
       (<| (_.context "Cross-platform support.")
           ..cross-platform-support)
-      (<| (_.context "/cli")
+      (<| (_.context "/cli Command-Line Interface.")
           /cli.test)
-      (<| (_.context "/host")
+      (<| (_.context "/io I/O (input/output)")
+          /io.test)
+      (<| (_.context "/host Host-platform interoperation")
           ($_ _.and
               /host.test
-              (<| (_.context "/jvm")
+              (<| (_.context "/jvm JVM (Java Virtual Machine)")
                   /jvm.test)))
       ))
diff --git a/stdlib/test/test/lux/control/apply.lux b/stdlib/test/test/lux/control/apply.lux
new file mode 100644
index 000000000..01fb33797
--- /dev/null
+++ b/stdlib/test/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)
+                 )))
diff --git a/stdlib/test/test/lux/control/functor.lux b/stdlib/test/test/lux/control/functor.lux
new file mode 100644
index 000000000..a93edc291
--- /dev/null
+++ b/stdlib/test/test/lux/control/functor.lux
@@ -0,0 +1,56 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   ["." function]
+   [math
+    ["r" random]]
+   ["_" test (#+ Test)]]
+  {1
+   ["." / (#+ Functor)]})
+
+(type: #export (Injection f)
+  (All [a] (-> a (f a))))
+
+(type: #export (Comparison f)
+  (All [a]
+    (-> (-> a a Bit)
+        (-> (f a) (f a) Bit))))
+
+(def: (identity (^open "_/.") injection comparison)
+  (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample (:: @ map injection r.nat)]
+    (_.test "Identity."
+            ((comparison n/=)
+             (_/map function.identity sample)
+             sample))))
+
+(def: (homomorphism (^open "_/.") injection comparison)
+  (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     increase (:: @ map n/+ r.nat)]
+    (_.test "Homomorphism."
+            ((comparison n/=)
+             (_/map increase (injection sample))
+             (injection (increase sample))))))
+
+(def: (composition (^open "_/.") injection comparison)
+  (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample (:: @ map injection r.nat)
+     increase (:: @ map n/+ r.nat)
+     decrease (:: @ map n/- r.nat)]
+    (_.test "Composition."
+            ((comparison n/=)
+             (|> sample (_/map increase) (_/map decrease))
+             (|> sample (_/map (|>> increase decrease)))))))
+
+(def: #export (laws functor injection comparison)
+  (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+  (_.context "Functor laws."
+             ($_ _.and
+                 (..identity functor injection comparison)
+                 (..homomorphism functor injection comparison)
+                 (..composition functor injection comparison))))
diff --git a/stdlib/test/test/lux/control/monad.lux b/stdlib/test/test/lux/control/monad.lux
new file mode 100644
index 000000000..412f3ab94
--- /dev/null
+++ b/stdlib/test/test/lux/control/monad.lux
@@ -0,0 +1,54 @@
+(.module:
+  [lux #*
+   ["." function]
+   [math
+    ["r" random]]
+   ["_" test (#+ Test)]]
+  {1
+   ["." / (#+ Monad do)]}
+  [//
+   [functor (#+ Injection Comparison)]])
+
+(def: (left-identity (^open "_/.") injection comparison)
+  (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     morphism (:: @ map (function (_ diff)
+                          (|>> (n/+ diff) _/wrap))
+                  r.nat)]
+    (_.test "Left identity."
+            ((comparison n/=)
+             (|> (injection sample) (_/map morphism) _/join)
+             (morphism sample)))))
+
+(def: (right-identity (^open "_/.") injection comparison)
+  (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat]
+    (_.test "Right identity."
+            ((comparison n/=)
+             (|> (injection sample) (_/map _/wrap) _/join)
+             (injection sample)))))
+
+(def: (associativity (^open "_/.") injection comparison)
+  (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+  (do r.monad
+    [sample r.nat
+     increase (:: @ map (function (_ diff)
+                          (|>> (n/+ diff) _/wrap))
+                  r.nat)
+     decrease (:: @ map (function (_ diff)
+                          (|>> (n/- diff) _/wrap))
+                  r.nat)]
+    (_.test "Associativity."
+            ((comparison n/=)
+             (|> (injection sample) (_/map increase) _/join (_/map decrease) _/join)
+             (|> (injection sample) (_/map (|>> increase (_/map decrease) _/join)) _/join)))))
+
+(def: #export (laws monad injection comparison)
+  (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+  (_.context "Monad laws."
+             ($_ _.and
+                 (..left-identity monad injection comparison)
+                 (..right-identity monad injection comparison)
+                 (..associativity monad injection comparison))))
diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux
index 86143fe27..a14a240cb 100644
--- a/stdlib/test/test/lux/io.lux
+++ b/stdlib/test/test/lux/io.lux
@@ -1,24 +1,39 @@
 (.module:
   [lux #*
-   ["&" io]
    [control
-    ["M" monad (#+ do Monad)]]
-   [data
-    [number]
-    [text ("text/." equivalence)
-     format]]]
-  lux/test)
+    [monad (#+ do)]
+    {[0 #test]
+     [/
+      [".T" functor (#+ Injection Comparison)]
+      [".T" apply]
+      [".T" monad]]}]
+   ["." function]
+   [math
+    ["r" random]]
+   ["_" test (#+ Test)]]
+  {1
+   ["." / (#+ IO)]})
 
-(context: "I/O"
-  ($_ seq
-      (test "" (text/= "YOLO" (&.run (&.io "YOLO"))))
-      (test "" (i/= +11 (&.run (:: &.functor map inc (&.io +10)))))
-      (test "" (i/= +10 (&.run (:: &.monad wrap +10))))
-      (test "" (i/= +30 (&.run (let [(^open "&/.") &.apply
-                                     (^open "&/.") &.monad]
-                                 (&/apply (&/wrap (i/+ +10)) (&/wrap +20))))))
-      (test "" (i/= +30 (&.run (do &.monad
-                                 [f (wrap i/+)
-                                  x (wrap +10)
-                                  y (wrap +20)]
-                                 (wrap (f x y))))))))
+(def: injection
+  (Injection IO)
+  (|>> /.io))
+
+(def: comparison
+  (Comparison IO)
+  (function (_ == left right)
+    (== (/.run left) (/.run right))))
+
+(def: #export test
+  Test
+  (do r.monad
+    [sample r.nat
+     exit-code r.int]
+    ($_ _.and
+        (_.test "Can execute computations designated as I/O computations."
+                (n/= sample (/.run (/.io sample))))
+        (_.test "I/O operations won't execute unless they are explicitly run."
+                (exec (/.exit exit-code)
+                  true))
+        (functorT.laws /.functor ..injection ..comparison)
+        (applyT.laws /.apply ..injection ..comparison)
+        (monadT.laws /.monad ..injection ..comparison))))
-- 
cgit v1.2.3