Mo' updates, less problems.

7 files changed, 207 insertions, 104 deletions

diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 7d91ebed7..9d2cf9069 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -21,11 +21,9 @@
   ["." / #_
    ["#." type]
    ["#." extension]
-   ["#." value]
+   ["#." time]
    ["#." versioning]
-   ["#." time_stamp
-    ["#/." date]
-    ["#/." time]]]
+   ["#." snapshot]]
   {#program
    ["." /]})
 
@@ -47,9 +45,7 @@
                  
                  /type.test
                  /extension.test
-                 /value.test
+                 /time.test
                  /versioning.test
-                 /time_stamp.test
-                 /time_stamp/date.test
-                 /time_stamp/time.test
+                 /snapshot.test
                  ))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index f1200381a..a39671ea4 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -93,38 +93,9 @@
                   (check_neighbors odd? value)
                   (check_neighbors even? value))))))
 
-(type: (Choice a)
-  (-> a a a))
-
-(type: (Order a)
-  (-> a a Bit))
-
 (type: (Equivalence a)
   (-> a a Bit))
 
-(def: (choice rand_gen = [< choose])
-  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test))
-  (do random.monad
-    [left rand_gen
-     right rand_gen
-     #let [choice (choose left right)]]
-    ($_ _.and
-        (_.test "The choice between 2 values is one of them."
-                (or (= left choice)
-                    (= right choice)))
-        (_.test "The choice between 2 values implies an order relationship between them."
-                (if (= left choice)
-                  (< right choice)
-                  (< left choice))))))
-
-(def: (minimum_and_maximum rand_gen = min' max')
-  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test))
-  ($_ _.and
-      (<| (_.context "Minimum.")
-          (choice rand_gen = min'))
-      (<| (_.context "Maximum.")
-          (choice rand_gen = max'))))
-
 (def: (conversion rand_gen forward backward =)
   (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test))
   (do random.monad
@@ -213,6 +184,18 @@
                            @.js on_valid_host}
                           on_default))))))
 
+(def: conversion_tests
+  Test
+  (`` ($_ _.and
+          (~~ (template [<=> <forward> <backward> <gen>]
+                [(<| (_.context (format (%.name (name_of <forward>))
+                                        " " (%.name (name_of <backward>))))
+                     (..conversion <gen> <forward> <backward> <=>))]
+
+                [i.= .nat .int (random\map (i.% +1,000,000) random.int)]
+                [n.= .int .nat (random\map (n.%  1,000,000) random.nat)]
+                )))))
+
 (def: sub_tests
   Test
   (let [tail (: (List Test)
@@ -236,6 +219,7 @@
                           ))))
 
 (def: test
+  Test
   (<| (_.context (name.module (name_of /._)))
       ($_ _.and
           (<| (_.context "Identity.")
@@ -248,30 +232,8 @@
                       (..even_or_odd random.nat n.even? n.odd?))
                   (<| (_.context "Integers.")
                       (..even_or_odd random.int i.even? i.odd?))))
-          (<| (_.context "Minimum and maximum.")
-              (`` ($_ _.and
-                      (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>]
-                            [(<| (_.context <context>)
-                                 (..minimum_and_maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
-
-                            [i.= i.< i.min i.> i.max random.int       "Integers."]
-                            [n.= n.< n.min n.> n.max random.nat       "Natural numbers."]
-                            [r.= r.< r.min r.> r.max random.rev       "Revolutions."]
-                            [f.= f.< f.min f.> f.max random.safe_frac "Fractions."]
-                            )))))
           (<| (_.context "Conversion.")
-              (`` ($_ _.and
-                      (~~ (template [<=> <forward> <backward> <gen>]
-                            [(<| (_.context (format (%.name (name_of <forward>))
-                                                    " " (%.name (name_of <backward>))))
-                                 (..conversion <gen> <forward> <backward> <=>))]
-
-                            [i.= .nat   .int   (random\map (i.% +1,000,000) random.int)]
-                            [n.= .int   .nat   (random\map (n.%  1,000,000) random.nat)]
-                            [i.= i.frac f.int  (random\map (i.% +1,000,000) random.int)]
-                            [f.= f.int  i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)]
-                            [r.= r.frac f.rev  frac_rev]
-                            )))))
+              ..conversion_tests)
           (<| (_.context "Prelude macros.")
               ..prelude_macros)
           (<| (_.context "Templates.")
diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux
index 62c576d27..e413afc95 100644
--- a/stdlib/source/test/lux/data/name.lux
+++ b/stdlib/source/test/lux/data/name.lux
@@ -42,7 +42,7 @@
                    (_.for [/.equivalence]
                           ($equivalence.spec /.equivalence (..random sizeM1 sizeS1)))
                    (_.for [/.hash]
-                          (|> (random.ascii 2)
+                          (|> (random.ascii 1)
                               (\ ! map (|>> [""]))
                               ($hash.spec /.hash)))
                    (_.for [/.order]
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index c89ca97ba..983649a89 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -240,7 +240,7 @@
           (_.for [/.equivalence]
                  ($equivalence.spec /.equivalence (random.ascii 2)))
           (_.for [/.hash]
-                 (|> (random.ascii 2)
+                 (|> (random.ascii 1)
                      ($hash.spec /.hash)))
           (_.for [/.order]
                  ($order.spec /.order (random.ascii 2)))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 0f217e335..730671b5b 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -170,8 +170,12 @@
                                [/.local_identifier ..random_text #.Identifier]
                                )))))
           (do {! random.monad}
-            [[original substitute] (random.and ..random ..random)
-             [sample expected] (..replace_simulation [original substitute])]
+            [[original substitute] (random.filter (function (_ [original substitute])
+                                                    (not (\ /.equivalence = original substitute)))
+                                                  (random.and ..random ..random))
+             [sample expected] (random.filter (function (_ [sample expected])
+                                                (not (\ /.equivalence = sample expected)))
+                                              (..replace_simulation [original substitute]))]
             (_.cover [/.replace]
                      (\ /.equivalence =
                         expected
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux
index b0c69b814..461d5bfac 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/modular.lux
@@ -4,6 +4,7 @@
    ["." type ("#\." equivalence)]
    [abstract
     [monad (#+ do)]
+    ["." predicate]
     {[0 #spec]
      [/
       ["$." equivalence]
@@ -41,7 +42,8 @@
         [param\\% ($//.random +1,000,000)
          param (..random param\\%)
 
-         subject\\% (random.filter (|>> (//.= param\\%) not)
+         subject\\% (random.filter (predicate.intersect (|>> //.divisor (i.> +2))
+                                                        (|>> (//.= param\\%) not))
                                    ($//.random +1,000,000))
          subject (..random subject\\%)
          another (..random subject\\%)]
diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux
index 54150772e..1a56d8d08 100644
--- a/stdlib/source/test/lux/type/resource.lux
+++ b/stdlib/source/test/lux/type/resource.lux
@@ -1,53 +1,192 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
+   ["." meta]
    [abstract
-    [monad
+    ["." monad
      [indexed (#+ do)]]]
    [control
-    ["." io]]
+    ["." io]
+    ["." try]
+    ["." exception (#+ Exception)]
+    [concurrency
+     ["." promise]]
+    [parser
+     ["<.>" code]]]
+   [data
+    ["." text ("#\." equivalence)
+     ["%" format (#+ format)]]]
+   ["." macro
+    [syntax (#+ syntax:)]
+    ["." code]]
    [math
-    [number
-     ["n" nat]]]]
+    ["." random]]]
   {1
    ["." / (#+ Res)]})
 
+(def: pure
+  Test
+  (monad.do {! random.monad}
+    [pre (\ ! map %.nat random.nat)
+     post (\ ! map %.nat random.nat)]
+    (_.for [/.Linear /.pure /.run_pure]
+           (`` ($_ _.and
+                   (~~ (template [<coverage> <bindings>]
+                         [(_.cover <coverage>
+                                   (<| (text\= (format pre post))
+                                       /.run_pure
+                                       (do /.pure
+                                         <bindings>
+                                         (wrap (format left right)))))]
+                         
+                         [[/.Affine /.Key /.Res /.Ordered /.ordered_pure
+                           /.Relevant /.read_pure]
+                          [res|left (/.ordered_pure pre)
+                           res|right (/.ordered_pure post)
+                           right (/.read_pure res|right)
+                           left (/.read_pure res|left)]]
+                         [[/.Commutative /.commutative_pure /.exchange_pure]
+                          [res|left (/.commutative_pure pre)
+                           res|right (/.commutative_pure post)
+                           _ (/.exchange_pure [1 0])
+                           left (/.read_pure res|left)
+                           right (/.read_pure res|right)]]
+                         [[/.group_pure /.un_group_pure]
+                          [res|left (/.commutative_pure pre)
+                           res|right (/.commutative_pure post)
+                           _ (/.group_pure 2)
+                           _ (/.un_group_pure 2)
+                           right (/.read_pure res|right)
+                           left (/.read_pure res|left)]]
+                         [[/.lift_pure]
+                          [left (/.lift_pure pre)
+                           right (/.lift_pure post)]]
+                         ))
+                   )))))
+
+(def: sync
+  Test
+  (monad.do {! random.monad}
+    [pre (\ ! map %.nat random.nat)
+     post (\ ! map %.nat random.nat)]
+    (_.for [/.Linear /.sync /.run_sync]
+           (`` ($_ _.and
+                   (~~ (template [<coverage> <bindings>]
+                         [(_.cover <coverage>
+                                   (<| (text\= (format pre post))
+                                       io.run
+                                       /.run_sync
+                                       (do /.sync
+                                         <bindings>
+                                         (wrap (format left right)))))]
+
+                         [[/.Affine /.Key /.Res /.Ordered /.ordered_sync
+                           /.Relevant /.read_sync]
+                          [res|left (/.ordered_sync pre)
+                           res|right (/.ordered_sync post)
+                           right (/.read_sync res|right)
+                           left (/.read_sync res|left)]]
+                         [[/.Commutative /.commutative_sync /.exchange_sync]
+                          [res|left (/.commutative_sync pre)
+                           res|right (/.commutative_sync post)
+                           _ (/.exchange_sync [1 0])
+                           left (/.read_sync res|left)
+                           right (/.read_sync res|right)]]
+                         [[/.group_sync /.un_group_sync]
+                          [res|left (/.commutative_sync pre)
+                           res|right (/.commutative_sync post)
+                           _ (/.group_sync 2)
+                           _ (/.un_group_sync 2)
+                           right (/.read_sync res|right)
+                           left (/.read_sync res|left)]]
+                         [[/.lift_sync]
+                          [left (/.lift_sync (io.io pre))
+                           right (/.lift_sync (io.io post))]]
+                         ))
+                   )))))
+
+(def: async
+  Test
+  (monad.do {! random.monad}
+    [pre (\ ! map %.nat random.nat)
+     post (\ ! map %.nat random.nat)]
+    (_.for [/.Linear /.async /.run_async]
+           (`` ($_ _.and
+                   (~~ (template [<coverage> <bindings>]
+                         [(wrap (monad.do promise.monad
+                                  [outcome (/.run_async
+                                            (do /.async
+                                              <bindings>
+                                              (wrap (format left right))))]
+                                  (_.cover' <coverage>
+                                            (text\= (format pre post)
+                                                    outcome))))]
+
+                         [[/.Affine /.Key /.Res /.Ordered /.ordered_async
+                           /.Relevant /.read_async]
+                          [res|left (/.ordered_async pre)
+                           res|right (/.ordered_async post)
+                           right (/.read_async res|right)
+                           left (/.read_async res|left)]]
+                         [[/.Commutative /.commutative_async /.exchange_async]
+                          [res|left (/.commutative_async pre)
+                           res|right (/.commutative_async post)
+                           _ (/.exchange_async [1 0])
+                           left (/.read_async res|left)
+                           right (/.read_async res|right)]]
+                         [[/.group_async /.un_group_async]
+                          [res|left (/.commutative_async pre)
+                           res|right (/.commutative_async post)
+                           _ (/.group_async 2)
+                           _ (/.un_group_async 2)
+                           right (/.read_async res|right)
+                           left (/.read_async res|left)]]
+                         [[/.lift_async]
+                          [left (/.lift_async (promise.resolved pre))
+                           right (/.lift_async (promise.resolved post))]]
+                         ))
+                   )))))
+
+(syntax: (with_error {exception <code>.identifier} to_expand)
+  (monad.do meta.monad
+    [[_ _ _ exception] (meta.find_export exception)]
+    (function (_ compiler)
+      (#.Right [compiler
+                (list (code.bit (case ((macro.expand_once to_expand) compiler)
+                                  (#try.Success _)
+                                  false
+                                  
+                                  (#try.Failure error)
+                                  true)))]))))
+
 (def: #export test
   Test
-  (<| (_.context (%.name (name_of /._)))
+  (<| (_.covering /._)
+      (_.for [/.Procedure])
       ($_ _.and
-          (_.test "Can produce and consume keys in an ordered manner."
-                  (<| (n.= (n.+ 123 456))
-                      io.run
-                      /.run_sync
-                      (do /.sync
-                        [res|left (/.ordered_sync 123)
-                         res|right (/.ordered_sync 456)
-                         right (/.read_sync res|right)
-                         left (/.read_sync res|left)]
-                        (wrap (n.+ left right)))))
-          (_.test "Can exchange commutative keys."
-                  (<| (n.= (n.+ 123 456))
-                      io.run
-                      /.run_sync
-                      (do /.sync
-                        [res|left (/.commutative_sync 123)
-                         res|right (/.commutative_sync 456)
-                         _ (/.exchange_sync [1 0])
-                         left (/.read_sync res|left)
-                         right (/.read_sync res|right)]
-                        (wrap (n.+ left right)))))
-          (_.test "Can group and un-group keys."
-                  (<| (n.= (n.+ 123 456))
-                      io.run
-                      /.run_sync
-                      (do /.sync
-                        [res|left (/.commutative_sync 123)
-                         res|right (/.commutative_sync 456)
-                         _ (/.group_sync 2)
-                         _ (/.un_group_sync 2)
-                         right (/.read_sync res|right)
-                         left (/.read_sync res|left)]
-                        (wrap (n.+ left right)))))
+          ..pure
+          ..sync
+          ..async
+
+          (_.cover [/.amount_cannot_be_zero]
+                   (`` (and (~~ (template [<group|un_group>]
+                                  [(with_error /.amount_cannot_be_zero
+                                     (<group|un_group> 0))]
+
+                                  [/.group_pure]
+                                  [/.group_sync]
+                                  [/.group_async]
+                                  [/.un_group_pure]
+                                  [/.un_group_sync]
+                                  [/.un_group_async]
+                                  )))))
+          (_.cover [/.index_cannot_be_repeated]
+                   (`` (and (~~ (template [<exchange>]
+                                  [(with_error /.index_cannot_be_repeated
+                                     (<exchange> [0 0]))]
+
+                                  [/.exchange_pure]
+                                  [/.exchange_sync]
+                                  [/.exchange_async]
+                                  )))))
           )))