Test for Aedifex's "auto" command.

7 files changed, 397 insertions, 109 deletions

diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index 71d9a29bb..02d2b8ed2 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -15,7 +15,8 @@
     ["#/." deploy]
     ["#/." deps]
     ["#/." build]
-    ["#/." test]]
+    ["#/." test]
+    ["#/." auto]]
    ["#." local]
    ["#." cache]
    ["#." dependency
@@ -42,6 +43,7 @@
       /command/deps.test
       /command/build.test
       /command/test.test
+      /command/auto.test
       /local.test
       /cache.test
       /dependency.test
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
new file mode 100644
index 000000000..13039d9d3
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -0,0 +1,147 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try]
+    [parser
+     ["." environment]]
+    [concurrency
+     ["." atom (#+ Atom)]
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    ["." text
+     ["%" format (#+ format)]]
+    [number
+     ["n" nat]]
+    [collection
+     ["." dictionary]
+     ["." set]
+     ["." list ("#\." functor)]]]
+   [math
+    ["." random]]
+   [world
+    [environment (#+ Environment)]
+    ["." shell (#+ Shell)]
+    ["." file (#+ Path)
+     ["." watch]]]]
+  ["$." /// #_
+   ["#." package]]
+  {#program
+   ["." /
+    ["/#" // #_
+     ["#." build]
+     ["/#" // #_
+      [command (#+ Command)]
+      ["#" profile (#+ Profile)]
+      ["#." action]
+      ["#." artifact
+       ["#/." type]]
+      ["#." dependency
+       ["#/." resolution (#+ Resolution)]]]]]})
+
+(def: (command end-signal dummy-files)
+  (-> Text (List Path)
+      [(Atom [Nat (List Path)])
+       (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))])
+  (let [@runs (: (Atom [Nat (List Path)])
+                 (atom.atom [0 dummy-files]))]
+    [@runs
+     (function (_ environment fs shell resolution profile)
+       (do {! promise.monad}
+         [[runs remaining-files] (promise.future
+                                  (atom.update (function (_ [runs remaining-files])
+                                                 [(inc runs) remaining-files])
+                                               @runs))]
+         (case remaining-files
+           #.Nil
+           (wrap (#try.Failure end-signal))
+           
+           (#.Cons head tail)
+           (do (try.with !)
+             [_ (!.use (:: fs create-file) [head])]
+             (do !
+               [_ (promise.future (atom.write [runs tail] @runs))]
+               (wrap (#try.Success [])))))))]))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do {! random.monad}
+        [#let [/ (:: file.default separator)
+               [fs watcher] (watch.mock /)
+               shell (shell.mock
+                      (function (_ [actual-environment actual-working-directory actual-command actual-arguments])
+                        (#try.Success
+                         (: (shell.Simulation [])
+                            (structure
+                             (def: (on-read state)
+                               (#try.Failure "on-read"))
+                             (def: (on-error state)
+                               (#try.Failure "on-error"))
+                             (def: (on-write input state)
+                               (#try.Failure "on-write"))
+                             (def: (on-destroy state)
+                               (#try.Failure "on-destroy"))
+                             (def: (on-await state)
+                               (#try.Success [state shell.normal]))))))
+                      [])]
+         end-signal (random.ascii/alpha 5)
+         program (random.ascii/alpha 5)
+         target (random.ascii/alpha 5)
+         working-directory (random.ascii/alpha 5)
+         expected-runs (:: ! map (|>> (n.% 10) (n.max 2)) random.nat)
+         source (random.ascii/alpha 5)
+         dummy-files (|> (random.ascii/alpha 5)
+                         (random.set text.hash (dec expected-runs))
+                         (:: ! map (|>> set.to-list (list\map (|>> (format source /))))))
+         #let [empty-profile (: Profile
+                                (:: ///.monoid identity))
+               with-target (: (-> Profile Profile)
+                              (set@ #///.target (#.Some target)))
+               with-program (: (-> Profile Profile)
+                               (set@ #///.program (#.Some program)))
+               
+               profile (|> empty-profile
+                           with-program
+                           with-target
+                           (set@ #///.sources (set.from-list text.hash (list source))))
+               
+               environment (dictionary.put "user.dir" working-directory environment.empty)]]
+        ($_ _.and
+            (do !
+              [lux-version (random.ascii/alpha 5)
+               [_ compiler-package] $///package.random
+               #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group
+                                                            #///artifact.name //build.jvm-compiler-name
+                                                            #///artifact.version lux-version}
+                                   #///dependency.type ///artifact/type.lux-library}
+                     js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group
+                                                           #///artifact.name //build.js-compiler-name
+                                                           #///artifact.version lux-version}
+                                  #///dependency.type ///artifact/type.lux-library}]
+               compiler-dependency (random.either (wrap jvm-compiler)
+                                                  (wrap js-compiler))
+               #let [[@runs command] (..command end-signal dummy-files)]]
+              (wrap (do promise.monad
+                      [verdict (do ///action.monad
+                                 [_ (!.use (:: fs create-directory) [source])
+                                  _ (:: watcher poll [])
+                                  #let [resolution (|> ///dependency/resolution.empty
+                                                       (dictionary.put compiler-dependency compiler-package))]]
+                                 (do promise.monad
+                                   [outcome ((/.do! watcher command) environment fs shell resolution profile)
+                                    [actual-runs _] (promise.future (atom.read @runs))]
+                                   (wrap (#try.Success (and (n.= expected-runs actual-runs)
+                                                            (case outcome
+                                                              (#try.Failure error)
+                                                              (is? end-signal error)
+
+                                                              (#try.Success _)
+                                                              false))))))]
+                      (_.cover' [/.do!]
+                                (try.default false verdict)))))
+            ))))
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux
index 3525a5fc8..83cfe60fb 100644
--- a/stdlib/source/test/lux/data/collection/set.lux
+++ b/stdlib/source/test/lux/data/collection/set.lux
@@ -1,8 +1,8 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
+    [hash (#+ Hash)]
     [monad (#+ do)]
     {[0 #spec]
      [/
@@ -17,7 +17,7 @@
    [math
     ["." random (#+ Random)]]]
   {1
-   ["." /]})
+   ["." / ("\." equivalence)]})
 
 (def: gen-nat
   (Random Nat)
@@ -28,8 +28,7 @@
   Test
   (<| (_.covering /._)
       (_.with-cover [/.Set])
-      (let [(^open "/\.") /.equivalence])
-      (do random.monad
+      (do {! random.monad}
         [size ..gen-nat]
         ($_ _.and
             (_.with-cover [/.equivalence]
@@ -37,7 +36,7 @@
             (_.with-cover [/.monoid]
               ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat)))
 
-            (do random.monad
+            (do !
               [sizeL ..gen-nat
                sizeR ..gen-nat
                setL (random.set n.hash sizeL random.nat)
@@ -45,13 +44,26 @@
                non-memberL (random.filter (|>> (/.member? setL) not)
                                           random.nat)]
               ($_ _.and
+                  (_.cover [/.new]
+                           (/.empty? (/.new n.hash)))
+                  (do !
+                    [hash (:: ! map (function (_ constant)
+                                      (: (Hash Nat)
+                                         (structure
+                                          (def: &equivalence n.equivalence)
+                                          
+                                          (def: (hash _)
+                                            constant))))
+                              random.nat)]
+                    (_.cover [/.member-hash]
+                             (is? hash (/.member-hash (/.new hash)))))
                   (_.cover [/.size]
                            (n.= sizeL (/.size setL)))
                   (_.cover [/.empty?]
                            (bit\= (/.empty? setL)
                                   (n.= 0 (/.size setL))))
                   (_.cover [/.to-list /.from-list]
-                           (|> setL /.to-list (/.from-list n.hash) (/\= setL)))
+                           (|> setL /.to-list (/.from-list n.hash) (\= setL)))
                   (_.cover [/.member?]
                            (and (list.every? (/.member? setL) (/.to-list setL))
                                 (not (/.member? setL non-memberL))))
@@ -72,12 +84,12 @@
                                  (|> setL
                                      (/.add non-memberL)
                                      (/.remove non-memberL)
-                                     (/\= setL))
+                                     (\= setL))
 
                                  idempotency!
                                  (|> setL
                                      (/.remove non-memberL)
-                                     (/\= setL))]
+                                     (\= setL))]
                              (and symmetry!
                                   idempotency!)))
                   (_.cover [/.union /.sub?]
@@ -90,7 +102,7 @@
                                  union-with-empty-set!
                                  (|> setL
                                      (/.union (/.new n.hash))
-                                     (/\= setL))]
+                                     (\= setL))]
                              (and sets-are-subs-of-their-unions!
                                   union-with-empty-set!)))
                   (_.cover [/.intersection /.super?]
diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux
index d8b0ad3bf..9458bb12c 100644
--- a/stdlib/source/test/lux/data/number.lux
+++ b/stdlib/source/test/lux/data/number.lux
@@ -29,21 +29,6 @@
   (-> Text Text)
   (text.replace-all "," ""))
 
-(def: sub
-  Test
-  ($_ _.and
-      /i8.test
-      /i16.test
-      /i32.test
-      /i64.test
-      /nat.test
-      /int.test
-      /rev.test
-      /frac.test
-      /ratio.test
-      /complex.test
-      ))
-
 (def: #export test
   Test
   (<| (_.covering /._)
@@ -111,5 +96,15 @@
                                   [f.= f.hex "+dead.BEEF"]
                                   [f.= f.hex "-dead,BE.EF"]
                                   )))))
-          ..sub
+
+          /i8.test
+          /i16.test
+          /i32.test
+          /i64.test
+          /nat.test
+          /int.test
+          /rev.test
+          /frac.test
+          /ratio.test
+          /complex.test
           )))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index 365bf9e7f..fcffb7c45 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -1,6 +1,5 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
@@ -10,44 +9,171 @@
       ["$." order]
       ["$." monoid]
       ["$." codec]]}]
+   [data
+    ["." bit ("#\." equivalence)]]
    [math
-    ["." random]]]
+    ["." random (#+ Random)]]]
   {1
    ["." /
     [// #*
-     ["i" int]]]})
+     ["n" nat]
+     ["i" int]
+     ["r" rev]
+     ["." i64]]]})
+
+(def: random
+  (Random Frac)
+  (:: random.monad map (|>> (i.% +1,000,000) i.frac) random.int))
+
+(def: signature
+  Test
+  (`` ($_ _.and
+          (_.with-cover [/.equivalence /.=]
+            ($equivalence.spec /.equivalence random.safe-frac))
+          (_.with-cover [/.order /.<]
+            ($order.spec /.order random.safe-frac))
+          (~~ (template [<monoid> <compose>]
+                [(_.with-cover [<monoid> <compose>]
+                   ($monoid.spec /.equivalence <monoid> ..random))]
+
+                [/.addition /.+]
+                [/.multiplication /.*]
+                [/.minimum /.min]
+                [/.maximum /.max]
+                ))
+          (~~ (template [<codec>]
+                [(_.with-cover [<codec>]
+                   ($codec.spec /.equivalence <codec> random.safe-frac))]
+
+                [/.binary] [/.octal] [/.decimal] [/.hex]
+                ))
+          )))
+
+(def: constant
+  Test
+  (do random.monad
+    [sample random.safe-frac]
+    ($_ _.and
+        (_.cover [/.biggest]
+                 (/.<= /.biggest sample))
+        (_.cover [/.positive-infinity]
+                 (/.< /.positive-infinity sample))
+        (_.cover [/.smallest]
+                 (bit\= (/.positive? sample)
+                        (/.>= /.smallest sample)))
+        (_.cover [/.negative-infinity]
+                 (/.> /.negative-infinity sample))
+        (_.cover [/.not-a-number /.not-a-number?]
+                 (and (/.not-a-number? /.not-a-number)
+                      (not (or (/.= /.not-a-number sample)
+                               (/.not-a-number? sample)))))
+        )))
+
+(def: predicate
+  Test
+  (do {! random.monad}
+    [sample ..random
+     shift (:: ! map /.abs ..random)]
+    ($_ _.and
+        (_.cover [/.negative?]
+                 (bit\= (/.negative? sample)
+                        (/.< +0.0 sample)))
+        (_.cover [/.positive?]
+                 (bit\= (/.positive? sample)
+                        (/.> +0.0 sample)))
+        (_.cover [/.zero?]
+                 (bit\= (/.zero? sample)
+                        (/.= +0.0 sample)))
+        (_.cover [/.within?]
+                 (and (/.within? /.smallest sample sample)
+                      (/.within? (/.+ +1.0 shift) sample (/.+ shift sample))))
+        (_.cover [/.number?]
+                 (and (not (/.number? /.not-a-number))
+                      (not (/.number? /.positive-infinity))
+                      (not (/.number? /.negative-infinity))
+                      (/.number? sample)))
+        )))
+
+(def: conversion
+  Test
+  ($_ _.and
+      (do {! random.monad}
+        [expected (:: ! map (n.% 1,000,000) random.nat)]
+        (_.cover [/.nat]
+                 (|> expected n.frac /.nat (n.= expected))))
+      (do {! random.monad}
+        [expected (:: ! map (i.% +1,000,000) random.int)]
+        (_.cover [/.int]
+                 (|> expected i.frac /.int (i.= expected))))
+      (do {! random.monad}
+        [expected (:: ! map (|>> (i64.left-shift 32) .rev)
+                      random.nat)]
+        (_.cover [/.rev]
+                 (|> expected r.frac /.rev (r.= expected))))
+      ))
 
 (def: #export test
   Test
-  (let [gen-frac (:: random.monad map (|>> (i.% +100) i.frac) random.int)]
-    (<| (_.context (%.name (name-of /._)))
-        (`` ($_ _.and
-                ($equivalence.spec /.equivalence gen-frac)
-                ($order.spec /.order gen-frac)
-                (~~ (template [<monoid>]
-                      [(<| (_.context (%.name (name-of <monoid>)))
-                           ($monoid.spec /.equivalence <monoid> gen-frac))]
-
-                      [/.addition] [/.multiplication] [/.minimum] [/.maximum]
-                      ))
-                ## TODO: Uncomment ASAP
-                ## (~~ (template [<codec>]
-                ##     [(<| (_.context (%.name (name-of /.binary)))
-                ##          ($codec.spec /.equivalence <codec> gen-frac))]
-
-                ##     [/.binary] [/.octal] [/.decimal] [/.hex]
-                ##     ))
-                
-                (_.test "Alternate notations."
-                        (and (/.= (bin "+1100.1001")
-                                  (bin "+11,00.10,01"))
-                             (/.= (oct "-6152.43")
-                                  (oct "-615,2.43"))
-                             (/.= (hex "+deadBE.EF")
-                                  (hex "+dead,BE.EF"))))
-                (do random.monad
-                  [sample gen-frac]
-                  (_.test (format (%.name (name-of /.to-bits))
-                                  " & " (%.name (name-of /.from-bits)))
-                          (|> sample /.to-bits /.from-bits (/.= sample))))
-                )))))
+  (<| (_.covering /._)
+      (_.with-cover [.Frac])
+      (`` ($_ _.and
+              (do random.monad
+                [left random.safe-frac
+                 right random.safe-frac]
+                ($_ _.and
+                    (_.cover [/.>]
+                             (bit\= (/.> left right)
+                                    (/.< right left)))
+                    (_.cover [/.<= /.>=]
+                             (bit\= (/.<= left right)
+                                    (/.>= right left)))
+                    ))
+              (do random.monad
+                [left ..random
+                 right ..random]
+                ($_ _.and
+                    (_.cover [/.%]
+                             (let [rem (/.% left right)
+                                   div (|> right (/.- rem) (/./ left))]
+                               (/.= right
+                                    (|> div (/.* left) (/.+ rem)))))
+                    (_.cover [/./%]
+                             (let [[div rem] (/./% left right)]
+                               (and (/.= div (/./ left right))
+                                    (/.= rem (/.% left right)))))
+                    ))
+              (do random.monad
+                [sample random.safe-frac]
+                ($_ _.and
+                    (_.cover [/.-]
+                             (and (/.= +0.0 (/.- sample sample))
+                                  (/.= sample (/.- +0.0 sample))
+                                  (/.= (/.negate sample)
+                                       (/.- sample +0.0))))
+                    (_.cover [/./]
+                             (and (/.= +1.0 (/./ sample sample))
+                                  (/.= sample (/./ +1.0 sample))))
+                    (_.cover [/.abs]
+                             (bit\= (/.> sample (/.abs sample))
+                                    (/.negative? sample)))
+                    (_.cover [/.signum]
+                             (/.= (/.abs sample)
+                                  (/.* (/.signum sample) sample)))))
+              (do random.monad
+                [expected random.frac]
+                ($_ _.and
+                    (_.cover [/.to-bits /.from-bits]
+                             (let [actual (|> expected /.to-bits /.from-bits)]
+                               (or (/.= expected actual)
+                                   (and (/.not-a-number? expected)
+                                        (/.not-a-number? actual)))))
+                    (_.cover [/.negate]
+                             (and (/.= +0.0 (/.+ (/.negate expected) expected))
+                                  (|> expected /.negate /.negate (/.= expected))))
+                    ))
+              
+              ..signature
+              ..constant
+              ..predicate
+              ..conversion
+              ))))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index bbaaa5712..46749652e 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -31,31 +31,30 @@
 
 (def: (type' num-vars)
   (-> Nat (r.Random Type))
-  (do r.monad
-    [_ (wrap [])]
-    (let [(^open "R\.") r.monad
-          pairG (r.and (type' num-vars)
-                       (type' num-vars))
-          quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
-          random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
-                                          (R\map (|>> #.Product) pairG))
-                                (r.either (R\map (|>> #.Function) pairG)
-                                          (R\map (|>> #.Apply) pairG)))
-          random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
-                                              (R\map (|>> #.Ex) r.nat))]
-                      (case num-vars
-                        0 random-id
-                        _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
-                                    random-id)))
-          random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
-                                      (R\map (|>> #.ExQ) quantifiedG))]
-      ($_ r.either
-          (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
-          random-pair
-          random-id
-          random-quantified
-          (R\map (|>> #.Named) (r.and ..name (type' num-vars)))
-          ))))
+  (r.rec
+   (function (_ recur)
+     (let [(^open "R\.") r.monad
+           pairG (r.and recur recur)
+           quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars)))
+           random-pair (r.either (r.either (R\map (|>> #.Sum) pairG)
+                                           (R\map (|>> #.Product) pairG))
+                                 (r.either (R\map (|>> #.Function) pairG)
+                                           (R\map (|>> #.Apply) pairG)))
+           random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat)
+                                               (R\map (|>> #.Ex) r.nat))]
+                       (case num-vars
+                         0 random-id
+                         _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
+                                     random-id)))
+           random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG)
+                                       (R\map (|>> #.ExQ) quantifiedG))]
+       ($_ r.either
+           (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list))))
+           random-pair
+           random-id
+           random-quantified
+           (R\map (|>> #.Named) (r.and ..name (type' 0)))
+           )))))
 
 (def: type
   (r.Random Type)
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux
index 8d27ab307..5f55825e4 100644
--- a/stdlib/source/test/lux/world/file/watch.lux
+++ b/stdlib/source/test/lux/world/file/watch.lux
@@ -113,39 +113,46 @@
                                       (list.empty? poll/0)]
                                 file (!.use (:: fs create-file) [expected-path])
                                 poll/1 (:: watcher poll [])
+                                poll/1' (:: watcher poll [])
                                 #let [after-creation!
-                                      (case poll/1
-                                        (^ (list [actual-path concern]))
-                                        (and (text\= expected-path actual-path)
-                                             (and (/.creation? concern)
-                                                  (not (/.modification? concern))
-                                                  (not (/.deletion? concern))))
+                                      (and (case poll/1
+                                             (^ (list [actual-path concern]))
+                                             (and (text\= expected-path actual-path)
+                                                  (and (/.creation? concern)
+                                                       (not (/.modification? concern))
+                                                       (not (/.deletion? concern))))
 
-                                        _
-                                        false)]
+                                             _
+                                             false)
+                                           (list.empty? poll/1'))]
+                                _ (promise.delay 1 (#try.Success "Delay to make sure the over-write time-stamp always changes."))
                                 _ (!.use (:: file over-write) data)
                                 poll/2 (:: watcher poll [])
+                                poll/2' (:: watcher poll [])
                                 #let [after-modification!
-                                      (case poll/2
-                                        (^ (list [actual-path concern]))
-                                        (and (text\= expected-path actual-path)
-                                             (and (not (/.creation? concern))
-                                                  (/.modification? concern)
-                                                  (not (/.deletion? concern))))
+                                      (and (case poll/2
+                                             (^ (list [actual-path concern]))
+                                             (and (text\= expected-path actual-path)
+                                                  (and (not (/.creation? concern))
+                                                       (/.modification? concern)
+                                                       (not (/.deletion? concern))))
 
-                                        _
-                                        false)]
+                                             _
+                                             false)
+                                           (list.empty? poll/2'))]
                                 _ (!.use (:: file delete) [])
                                 poll/3 (:: watcher poll [])
+                                poll/3' (:: watcher poll [])
                                 #let [after-deletion!
-                                      (case poll/3
-                                        (^ (list [actual-path concern]))
-                                        (and (not (/.creation? concern))
-                                             (not (/.modification? concern))
-                                             (/.deletion? concern))
+                                      (and (case poll/3
+                                             (^ (list [actual-path concern]))
+                                             (and (not (/.creation? concern))
+                                                  (not (/.modification? concern))
+                                                  (/.deletion? concern))
 
-                                        _
-                                        false)]]
+                                             _
+                                             false)
+                                           (list.empty? poll/3'))]]
                                (wrap (and no-events-prior-to-creation!
                                           after-creation!
                                           after-modification!