Ported 2 new test modules to the new format.

5 files changed, 252 insertions, 161 deletions

diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux
index 708f385a2..978d6a683 100644
--- a/stdlib/source/lux/control/thread.lux
+++ b/stdlib/source/lux/control/thread.lux
@@ -12,7 +12,7 @@
    [platform
     [compiler
      ["." host]]]
-   [io (#+ IO)]])
+   ["." io (#+ IO)]])
 
 (type: #export (Thread ! a)
   (-> ! a))
@@ -47,6 +47,12 @@
         a))
   (thread []))
 
+(def: #export (io thread)
+  (All [a]
+    (-> (All [!] (Thread ! a))
+        (IO a)))
+  (io.io (..run thread)))
+
 (structure: #export functor
   (All [!] (Functor (Thread !)))
 
@@ -83,10 +89,3 @@
     [old (read box)
      _ (write (f old) box)]
     (wrap old)))
-
-(def: #export (io thread)
-  (All [a]
-    (-> (All [!] (Thread ! a))
-        (IO a)))
-  (function (_ void)
-    (thread void)))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index de2e00a31..97f8c8cf5 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -5,9 +5,11 @@
    ["/." continuation]
    ["/." exception]
    ["/." interval]
+   ["/." parser]
    ["/." pipe]
    ["/." reader]
    ["/." state]
+   ["/." thread]
    ["/." writer]])
 
 (def: #export test
@@ -16,8 +18,10 @@
       /continuation.test
       /exception.test
       /interval.test
+      /parser.test
       (<| (_.context "/pipe")
           /pipe.test)
       /reader.test
       /state.test
+      /thread.test
       /writer.test))
diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux
index c9d568495..47740098d 100644
--- a/stdlib/source/test/lux/control/parser.lux
+++ b/stdlib/source/test/lux/control/parser.lux
@@ -1,31 +1,42 @@
 (.module:
   [lux #*
+   ["_" test (#+ Test)]
    [control
-    ["M" monad (#+ do)]
+    [monad (#+ do)]
     [equivalence (#+ Equivalence)]
-    ["&" parser]]
+    {[0 #test]
+     [/
+      [".T" functor (#+ Injection Comparison)]
+      [".T" apply]
+      [".T" monad]]}]
    [data
-    ["." error (#+ Error)]]
+    ["." error (#+ Error)]
+    [number
+     ["." nat]]
+    ["." text ("#/." equivalence)
+     format]
+    [collection
+     ["." list ("#/." functor)]]]
    [math
     ["r" random]]
-   ["." macro
+   [macro
     ["." code]
-    ["s" syntax (#+ syntax:)]]]
-  lux/test)
+    ["s" syntax (#+ Syntax syntax:)]]]
+  {1
+   ["." / (#+ Parser)]})
 
-## [Utils]
-(def: (should-fail input)
-  (All [a] (-> (Error a) Bit))
+(def: (should-fail expected input)
+  (All [a] (-> Text (Error a) Bit))
   (case input
-    (#error.Failure _)
-    #1
+    (#error.Failure actual)
+    (text/= expected actual)
     
     _
     #0))
 
 (def: (enforced? parser input)
-  (All [s] (-> (&.Parser s Any) s Bit))
-  (case (&.run input parser)
+  (All [s] (-> (Parser s Any) s Bit))
+  (case (/.run input parser)
     (#error.Success [_ []])
     #1
 
@@ -33,8 +44,8 @@
     #0))
 
 (def: (found? parser input)
-  (All [s] (-> (&.Parser s Bit) s Bit))
-  (case (&.run input parser)
+  (All [s] (-> (Parser s Bit) s Bit))
+  (case (/.run input parser)
     (#error.Success [_ #1])
     #1
 
@@ -50,128 +61,180 @@
     _
     #0))
 
-(syntax: (match pattern input)
+(syntax: (match pattern then input)
   (wrap (list (` (case (~ input)
                    (^ (#error.Success [(~' _) (~ pattern)]))
-                   #1
+                   (~ then)
 
                    (~' _)
                    #0)))))
 
-## [Tests]
-(context: "Assertions"
-  (test "Can make assertions while parsing."
-        (and (match []
-                    (&.run (list (code.bit #1) (code.int +123))
-                           (&.assert "yolo" #1)))
-             (fails? (&.run (list (code.bit #1) (code.int +123))
-                            (&.assert "yolo" #0))))))
-
-(context: "Combinators [Part 1]"
-  ($_ seq
-      (test "Can optionally succeed with some parser."
-            (and (match (#.Some 123)
-                        (&.run (list (code.nat 123))
-                               (&.maybe s.nat)))
-                 (match #.None
-                        (&.run (list (code.int -123))
-                               (&.maybe s.nat)))))
-
-      (test "Can apply a parser 0 or more times."
-            (and (match (list 123 456 789)
-                        (&.run (list (code.nat 123) (code.nat 456) (code.nat 789))
-                               (&.some s.nat)))
-                 (match (list)
-                        (&.run (list (code.int -123))
-                               (&.some s.nat)))))
-
-      (test "Can apply a parser 1 or more times."
-            (and (match (list 123 456 789)
-                        (&.run (list (code.nat 123) (code.nat 456) (code.nat 789))
-                               (&.many s.nat)))
-                 (match (list 123)
-                        (&.run (list (code.nat 123))
-                               (&.many s.nat)))
-                 (fails? (&.run (list (code.int -123))
-                                (&.many s.nat)))))
-
-      (test "Can use either parser."
-            (let [positive (: (s.Syntax Int)
-                              (do &.monad
-                                [value s.int
-                                 _ (&.assert "" (i/> +0 value))]
-                                (wrap value)))]
-              (and (match +123
-                          (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                                 (&.either positive s.int)))
-                   (match -123
-                          (&.run (list (code.int -123) (code.int +456) (code.int +789))
-                                 (&.either positive s.int)))
-                   (fails? (&.run (list (code.bit #1) (code.int +456) (code.int +789))
-                                  (&.either positive s.int))))))
-
-      (test "Can create the opposite/negation of any parser."
-            (and (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                                (&.not s.int)))
-                 (match []
-                        (&.run (list (code.bit #1) (code.int +456) (code.int +789))
-                               (&.not s.int)))))
-      ))
-
-(context: "Combinators Part [2]"
-  ($_ seq
-      (test "Can fail at will."
-            (should-fail (&.run (list)
-                                (&.fail "Well, it really SHOULD fail..."))))
-      
-      (test "Can apply a parser N times."
-            (and (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.exactly 3 s.int)))
-                 (match (list +123 +456)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.exactly 2 s.int)))
-                 (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                                (&.exactly 4 s.int)))))
-
-      (test "Can apply a parser at-least N times."
-            (and (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.at-least 3 s.int)))
-                 (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.at-least 2 s.int)))
-                 (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                                (&.at-least 4 s.int)))))
-
-      (test "Can apply a parser at-most N times."
-            (and (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.at-most 3 s.int)))
-                 (match (list +123 +456)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.at-most 2 s.int)))
-                 (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.at-most 4 s.int)))))
-
-      (test "Can apply a parser between N and M times."
-            (and (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                               (&.between 3 10 s.int)))
-                 (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789))
-                                (&.between 4 10 s.int)))))
-
-      (test "Can parse while taking separators into account."
-            (and (match (list +123 +456 +789)
-                        (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.text "YOLO") (code.int +789))
-                               (&.sep-by (s.this (' "YOLO")) s.int)))
-                 (match (list +123 +456)
-                        (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.int +789))
-                               (&.sep-by (s.this (' "YOLO")) s.int)))))
-
-      (test "Can obtain the whole of the remaining input."
-            (|> &.remaining
-                (&.run (list (code.int +123) (code.int +456) (code.int +789)))
-                (match (list [_ (#.Int +123)] [_ (#.Int +456)] [_ (#.Int +789)]))))
-      ))
+(def: combinators-0
+  Test
+  (do r.monad
+    [expected0 r.nat
+     variadic (:: @ map (|>> (n/max 1) (n/min 20)) r.nat)
+     expected+ (r.list variadic r.nat)
+     even0 (r.filter n/even? r.nat)
+     odd0 (r.filter n/odd? r.nat)
+     not0 r.bit]
+    ($_ _.and
+        (_.test "Can optionally succeed with some parser."
+                (and (|> (/.maybe s.nat)
+                         (/.run (list (code.nat expected0)))
+                         (match (#.Some actual)
+                                (n/= expected0 actual)))
+                     (|> (/.maybe s.nat)
+                         (/.run (list (code.int (.int expected0))))
+                         (match #.None
+                                #1))))
+        (_.test "Can apply a parser 0 or more times."
+                (and (|> (/.some s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) = expected+ actual)))
+                     (|> (/.some s.nat)
+                         (/.run (list/map (|>> .int code.int) expected+))
+                         (match #.Nil
+                                #1))))
+        (_.test "Can apply a parser 1 or more times."
+                (and (|> (/.many s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) = expected+ actual)))
+                     (|> (/.many s.nat)
+                         (/.run (list (code.nat expected0)))
+                         (match (list actual)
+                                (n/= expected0 actual)))
+                     (|> (/.many s.nat)
+                         (/.run (list/map (|>> .int code.int) expected+))
+                         fails?)))
+        (_.test "Can use either parser."
+                (let [even (/.filter n/even? s.nat)
+                      odd (/.filter n/odd? s.nat)]
+                  (and (|> (/.either even odd)
+                           (/.run (list (code.nat even0)))
+                           (match actual (n/= even0 actual)))
+                       (|> (/.either even odd)
+                           (/.run (list (code.nat odd0)))
+                           (match actual (n/= odd0 actual)))
+                       (|> (/.either even odd)
+                           (/.run (list (code.bit not0)))
+                           fails?))))
+        (_.test "Can create the opposite/negation of any parser."
+                (and (|> (/.not s.nat)
+                         (/.run (list (code.nat expected0)))
+                         fails?)
+                     (|> (/.not s.nat)
+                         (/.run (list (code.bit not0)))
+                         (match [] #1))))
+        )))
+
+(def: combinators-1
+  Test
+  (do r.monad
+    [failure (r.ascii 1)
+     variadic (:: @ map (|>> (n/max 1) (n/min 20)) r.nat)
+     times (:: @ map (n/% variadic) r.nat)
+     expected+ (r.list variadic r.nat)
+     separator (r.ascii 1)]
+    ($_ _.and
+        (_.test "Can fail at will."
+                (|> (/.fail failure)
+                    (/.run (list))
+                    (should-fail failure)))
+        (_.test "Can apply a parser N times."
+                (and (|> (/.exactly times s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    (list.take times expected+)
+                                    actual)))
+                     (|> (/.exactly (inc variadic) s.nat)
+                         (/.run (list/map code.nat expected+))
+                         fails?)))
+        (_.test "Can apply a parser at-least N times."
+                (and (|> (/.at-least times s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    expected+
+                                    actual)))
+                     (|> (/.at-least (inc variadic) s.nat)
+                         (/.run (list/map code.nat expected+))
+                         fails?)))
+        (_.test "Can apply a parser at-most N times."
+                (and (|> (/.at-most times s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    (list.take times expected+)
+                                    actual)))
+                     (|> (/.at-most (inc variadic) s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    expected+
+                                    actual)))))
+        (_.test "Can apply a parser between N and M times."
+                (and (|> (/.between times variadic s.nat)
+                         (/.run (list/map code.nat expected+))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    expected+
+                                    actual)))
+                     (|> (/.between times variadic s.nat)
+                         (/.run (list/map code.nat (list.take times expected+)))
+                         (match actual
+                                (:: (list.equivalence nat.equivalence) =
+                                    (list.take times expected+)
+                                    actual)))))
+        (_.test "Can parse while taking separators into account."
+                (|> (/.sep-by (s.this (code.text separator)) s.nat)
+                    (/.run (list.interpose (code.text separator) (list/map code.nat expected+)))
+                    (match actual
+                           (:: (list.equivalence nat.equivalence) =
+                               expected+
+                               actual))))
+        (_.test "Can obtain the whole of the remaining input."
+                (|> /.remaining
+                    (/.run (list/map code.nat expected+))
+                    (match actual
+                           (:: (list.equivalence code.equivalence) =
+                               (list/map code.nat expected+)
+                               actual))))
+        )))
+
+(def: (injection value)
+  (Injection (All [a i] (Parser i a)))
+  (:: /.monad wrap value))
+
+(def: comparison
+  (Comparison (All [a i] (Parser i a)))
+  (function (_ == left right)
+    (case [(/.run [] left) (/.run [] right)]
+      [(#error.Success [_ left]) (#error.Success [_ right])]
+      (== left right)
+
+      _
+      false)))
+
+(def: #export test
+  Test
+  (do r.monad
+    [assertion (r.ascii 1)]
+    (<| (_.context (%name (name-of /.Parser)))
+        ($_ _.and
+            (_.test "Can make assertions while parsing."
+                    (and (|> (/.assert assertion #1)
+                             (/.run (list (code.bit #1) (code.int +123)))
+                             (match [] #1))
+                         (|> (/.assert assertion #0)
+                             (/.run (list (code.bit #1) (code.int +123)))
+                             fails?)))
+            ..combinators-0
+            ..combinators-1
+            (functorT.laws ..injection ..comparison /.functor)
+            (applyT.laws ..injection ..comparison /.apply)
+            (monadT.laws ..injection ..comparison /.monad)
+            ))))
diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux
index 8f31addbb..61b7524cc 100644
--- a/stdlib/source/test/lux/control/thread.lux
+++ b/stdlib/source/test/lux/control/thread.lux
@@ -1,21 +1,44 @@
 (.module:
   [lux #*
+   ["_" test (#+ Test)]
    [control
     [monad (#+ do)]
-    ["/" thread]]])
+    {[0 #test]
+     [/
+      [".T" functor (#+ Injection Comparison)]
+      [".T" apply]
+      [".T" monad]]}]
+   [data
+    [text
+     format]]
+   [math
+    ["r" random]]]
+  {1
+   ["." / (#+ Thread)]})
 
-(def: _test0_
-  Nat
-  (/.run (do /.monad
-           [box (/.box 123)
-            old (/.update (n/* 2) box)
-            new (/.read box)]
-           (wrap (n/+ old new)))))
+(def: (injection value)
+  (Injection (All [a !] (Thread ! a)))
+  (:: /.monad wrap value))
 
-(def: _test1_
-  (All [!] (/.Thread ! Nat))
-  (do /.monad
-    [box (/.box 123)
-     old (/.update (n/* 2) box)
-     new (/.read box)]
-    (wrap (n/+ old new))))
+(def: comparison
+  (Comparison (All [a !] (Thread ! a)))
+  (function (_ == left right)
+    (== (/.run left) (/.run right))))
+
+(def: #export test
+  Test
+  (do r.monad
+    [original r.nat
+     factor r.nat]
+    (<| (_.context (%name (name-of /.Thread)))
+        ($_ _.and
+            (functorT.laws ..injection ..comparison /.functor)
+            (applyT.laws ..injection ..comparison /.apply)
+            (monadT.laws ..injection ..comparison /.monad)
+            (_.test "Can safely do mutation."
+                    (n/= (n/* factor original)
+                         (/.run (: (All [!] (Thread ! Nat))
+                                   (do /.monad
+                                     [box (/.box original)
+                                      old (/.update (n/* factor) box)]
+                                     (/.read box))))))))))
diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux
index 12670c58e..87d2de77a 100644
--- a/stdlib/source/test/lux/control/writer.lux
+++ b/stdlib/source/test/lux/control/writer.lux
@@ -32,7 +32,9 @@
 (def: #export test
   Test
   (do r.monad
-    [log (r.ascii 1)]
+    [log (r.ascii 1)
+     left r.nat
+     right r.nat]
     (<| (_.context (%name (name-of /.Writer)))
         ($_ _.and
             (_.test "Can write any value."
@@ -47,9 +49,9 @@
                   (^open "io/.") io.monad]
               (_.test "Can add writer functionality to any monad."
                       (|> (io.run (do (/.with-writer text.monoid io.monad)
-                                    [a (lift (io/wrap 123))
-                                     b (wrap 456)]
+                                    [a (lift (io/wrap left))
+                                     b (wrap right)]
                                     (wrap (n/+ a b))))
                           product.right
-                          (n/= 579))))
+                          (n/= (n/+ left right)))))
             ))))