Extracted property-based testing machinery into its own module.

1 files changed, 284 insertions, 0 deletions

diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux
new file mode 100644
index 000000000..ff61d64d5
--- /dev/null
+++ b/stdlib/source/library/lux/test/property.lux
@@ -0,0 +1,284 @@
+(.require
+ [library
+  [lux (.except and for)
+   ["[0]" debug]
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" pipe]
+    ["[0]" maybe]
+    ["[0]" try]
+    ["[0]" exception (.only exception)]
+    ["[0]" io]
+    [concurrency
+     ["[0]" atom (.only Atom)]
+     ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]]
+   [data
+    ["[0]" product]
+    ["[0]" text (.only)
+     ["%" \\format (.only format)]]
+    [collection
+     ["[0]" list (.use "[1]#[0]" functor mix)]
+     ["[0]" set]
+     ["[0]" dictionary
+      ["[1]" ordered (.only Dictionary)]]]]
+   [math
+    ["[0]" random (.only Random) (.use "[1]#[0]" monad)]
+    [number (.only hex)
+     ["n" nat]
+     ["f" frac]]]
+   [meta
+    ["@" target]
+    ["[0]" symbol]
+    ["[0]" code
+     ["<[1]>" \\parser]]
+    [macro
+     [syntax (.only syntax)]]]
+   [world
+    ["[0]" environment]
+    ["[0]" console]
+    [time
+     [duration (.only Duration)]
+     ["[0]" instant]]]]]
+ [//
+  ["//" unit]
+  ["[0]" coverage (.only Coverage)]
+  ["[0]" tally (.only Tally)]])
+
+(type .public Test
+  (Random //.Test))
+
+(def .public (and left right)
+  (-> Test Test Test)
+  (do [! random.monad]
+    [left left]
+    (at ! each (//.and left) right)))
+
+(def .public context
+  (-> Text Test Test)
+  (|>> %.text
+       //.context
+       random#each))
+
+(def .public failure
+  (-> Text Test)
+  (|>> //.failure
+       random#in))
+
+(def .public success
+  (-> Text Test)
+  (|>> //.success
+       random#in))
+
+(def .public (test message condition)
+  (-> Text Bit Test)
+  (random#in (//.test message condition)))
+
+(def .public (lifted message random)
+  (-> Text (Random Bit) Test)
+  (do random.monad
+    [it random]
+    (test message it)))
+
+(def pcg_32_magic_inc
+  Nat
+  (hex "FEDCBA9876543210"))
+
+(type .public Seed
+  Nat)
+
+(def .public (seed value test)
+  (-> Seed Test Test)
+  (function (_ prng)
+    (let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc value])
+                                    test)]
+      [prng result])))
+
+(def failed?
+  (-> Tally Bit)
+  (|>> (the tally.#failures) (n.> 0)))
+
+(def separator
+  text.new_line)
+
+(def (times_failure seed documentation)
+  (-> Seed Text Text)
+  (format documentation ..separator ..separator
+          "Failed with this seed: " (%.nat seed)))
+
+(exception .public must_try_test_at_least_once)
+
+(def .public (times amount test)
+  (-> Nat Test Test)
+  (case amount
+    0 (..failure (exception.error ..must_try_test_at_least_once []))
+    _ (do random.monad
+        [seed random.nat]
+        (function (again prng)
+          (let [[prng' instance] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) test)]
+            [prng' (do [! async.monad]
+                     [[tally documentation] instance]
+                     (if (..failed? tally)
+                       (in [tally (times_failure seed documentation)])
+                       (case amount
+                         1 instance
+                         _ (|> test
+                               (times (-- amount))
+                               (random.result prng')
+                               product.right))))])))))
+
+(def (description duration tally)
+  (-> Duration Tally Text)
+  (let [successes (the tally.#successes tally)
+        failures (the tally.#failures tally)
+        missing (set.difference (the tally.#actual tally)
+                                (the tally.#expected tally))
+        unexpected (set.difference (the tally.#expected tally)
+                                   (the tally.#actual tally))
+        report (is (-> Coverage Text)
+                   (|>> set.list
+                        (list.sorted (at symbol.order <))
+                        (exception.listing %.symbol)))
+        expected_coverage (set.size (the tally.#expected tally))
+        unexpected_coverage (set.size unexpected)
+        actual_coverage (n.- unexpected_coverage
+                             (set.size (the tally.#actual tally)))
+        coverage (case expected_coverage
+                   0 "N/A"
+                   expected (let [missing_ratio (f./ (n.frac expected)
+                                                     (n.frac (set.size missing)))
+                                  max_percent +100.0
+                                  done_percent (|> +1.0
+                                                   (f.- missing_ratio)
+                                                   (f.* max_percent))]
+                              (if (f.= max_percent done_percent)
+                                "100%"
+                                (let [raw (|> done_percent
+                                              %.frac
+                                              (text.replaced_once "+" ""))]
+                                  (|> raw
+                                      (text.clip 0 (if (f.< +10.0 done_percent)
+                                                     4 ...  X.XX
+                                                     5 ... XX.XX
+                                                     ))
+                                      (maybe.else raw)
+                                      (text.suffix "%"))))))]
+    (exception.report
+     (list ["Duration" (%.duration duration)]
+
+           ["Tests" (%.nat (n.+ successes failures))]
+           ["Successes" (%.nat successes)]
+           ["Failures" (%.nat failures)]
+           
+           ["Expected coverage" (%.nat expected_coverage)]
+           ["Actual coverage" (%.nat actual_coverage)]
+           ["Pending coverage" (%.nat (n.- actual_coverage
+                                           expected_coverage))]
+           ["Unexpected coverage" (%.nat unexpected_coverage)]
+           
+           ["Coverage" coverage]
+           ["Pending" (report missing)]
+           ["Unexpected" (report unexpected)]))))
+
+(def failure_exit_code +1)
+(def success_exit_code +0)
+
+(def .public (run! test)
+  (-> Test (Async Nothing))
+  (do async.monad
+    [pre (async.future instant.now)
+     .let [seed (instant.millis pre)
+           prng (random.pcg_32 [..pcg_32_magic_inc seed])]
+     [tally documentation] (|> test (random.result prng) product.right)
+     post (async.future instant.now)
+     .let [duration (instant.span pre post)
+           report (format documentation
+                          text.new_line text.new_line
+                          (..description duration tally)
+                          text.new_line)]
+     _ (with_expansions [<else> (in {try.#Success (debug.log! report)})]
+         (.for @.js (case console.default
+                      {.#None}
+                      <else>
+
+                      {.#Some console}
+                      (console.write_line report console))
+               <else>))]
+    (async.future (at environment.default exit
+                      (case (the tally.#failures tally)
+                        0 ..success_exit_code
+                        _ ..failure_exit_code)))))
+
+(def .public coverage
+  (syntax (_ [coverage <code>.any
+              condition <code>.any])
+    (in (list (` (at random.monad (,' in) (//.coverage (, coverage) (, condition))))))))
+
+(def .public for
+  (syntax (_ [coverage <code>.any
+              test <code>.any])
+    (in (list (` (at random.functor
+                     (,' each)
+                     (|>> (//.for (, coverage)))
+                     (, test)))))))
+
+(def .public covering
+  (syntax (_ [module <code>.any
+              test <code>.any])
+    (in (list (` (at random.functor
+                     (,' each)
+                     (|>> (//.covering (, module)))
+                     (, test)))))))
+
+(exception .public (error_during_execution [error Text])
+  (exception.report
+   (list ["Error" (%.text error)])))
+
+(def .public (in_parallel tests)
+  (-> (List Test) Test)
+  (case (list.size tests)
+    0
+    (random#in (async#in [tally.empty ""]))
+    
+    expected_tests
+    (do random.monad
+      [seed random.nat
+       .let [prng (random.pcg_32 [..pcg_32_magic_inc seed])
+             run! (is (-> Test //.Test)
+                      (|>> (random.result prng)
+                           product.right
+                           (function (_ _))
+                           "lux try"
+                           (pipe.case
+                             {try.#Success output}
+                             output
+                             
+                             {try.#Failure error}
+                             (//.test (exception.error ..error_during_execution [error]) false))))
+             state (is (Atom (Dictionary Nat [Tally Text]))
+                       (atom.atom (dictionary.empty n.order)))
+             [read! write!] (is [//.Test
+                                 (async.Resolver [Tally Text])]
+                                (async.async []))
+             _ (list#mix (function (_ test index)
+                           (exec
+                             (|> (run! test)
+                                 (async.upon! (function (_ assertion)
+                                                (do io.monad
+                                                  [[_ results] (atom.update! (dictionary.has index assertion) state)]
+                                                  (if (n.= expected_tests (dictionary.size results))
+                                                    (let [assertions (|> results
+                                                                         dictionary.entries
+                                                                         (list#each product.right))]
+                                                      (write! [(|> assertions
+                                                                   (list#each product.left)
+                                                                   (list#mix tally.and tally.empty))
+                                                               (|> assertions
+                                                                   (list#each product.right)
+                                                                   (text.interposed ..separator))]))
+                                                    (in [])))))
+                                 io.run!)
+                             (++ index)))
+                         0
+                         tests)]]
+      (in read!))))