diff options
| -rw-r--r-- | stdlib/source/lux.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/cli.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 78 | ||||
| -rw-r--r-- | stdlib/test/test/lux.lux | 1 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 5 |
5 files changed, 52 insertions, 46 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index d7b4164e2..ebac83f40 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2598,6 +2598,12 @@ [_ (#Tuple members)] (` (& (~+ (list/map walk-type members)))) + [_ (#Form (#Cons [_ (#Text "lux in-module")] + (#Cons [_ (#Text module)] + (#Cons type' + #Nil))))] + (` ("lux in-module" (~ (text$ module)) (~ (walk-type type')))) + [_ (#Form (#Cons type-fn args))] (list/fold ("lux check" (-> Code Code Code) (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 5a3672a39..b0f1285fa 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -121,14 +121,14 @@ (case args (#Raw args) (wrap (list (` ("lux program" (~ (code.symbol ["" args])) - (do io.Monad<IO> - [] - (~ body)))))) + ((~! do) (~! io.Monad<IO>) + [] + (~ body)))))) (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] (wrap (list (` ("lux program" (~ g!args) - (case ((: (..CLI (io.IO Unit)) + (case ((: (~! (..CLI (io.IO Unit))) ((~! do) (~! p.Monad<Parser>) [(~+ (|> args (list/map (function [[binding parser]] diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 864dadfb0..b755299cd 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -5,7 +5,7 @@ [code]) (control [monad #+ do Monad] ["p" parser]) - (concurrency [promise #+ Promise Monad<Promise>]) + (concurrency [promise #+ Promise]) (data (coll [list "list/" Monad<List> Fold<List>]) [product] [maybe] @@ -50,15 +50,15 @@ (def: #export (fail message) (All [a] (-> Text Test)) (|> [failure (format " [Error] " message)] - (:: Monad<Promise> wrap) + (:: promise.Monad<Promise> wrap) (:: r.Monad<Random> wrap))) (def: #export (assert message condition) {#.doc "Check that a condition is true, and fail with the given message otherwise."} (-> Text Bool (Promise [Counters Text])) (if condition - (:: Monad<Promise> wrap [success (format "[Success] " message)]) - (:: Monad<Promise> wrap [failure (format " [Error] " message)]))) + (:: promise.Monad<Promise> wrap [success (format "[Success] " message)]) + (:: promise.Monad<Promise> wrap [failure (format " [Error] " message)]))) (def: #export (test message condition) {#.doc "Check that a condition is true, and fail with the given message otherwise."} @@ -67,7 +67,7 @@ (def: (run' tests) (-> (List [Text (IO Test) Text]) (Promise Counters)) - (do Monad<Promise> + (do promise.Monad<Promise> [test-runs (|> tests (list/map (: (-> [Text (IO Test) Text] (Promise Counters)) (function [[module test description]] @@ -111,7 +111,7 @@ [seed r.nat] (function [prng] (let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)] - [prng' (do Monad<Promise> + [prng' (do promise.Monad<Promise> [[counters documentation] instance] (if (failed? counters) (wrap [counters (format "Failed with this seed: " (%n seed) "\n" documentation)]) @@ -185,13 +185,16 @@ (with-gensyms [g!context g!test g!error] (wrap (list (` (def: #export (~ g!context) {#..test ((~! code.text) (~ description))} - (IO Test) - (io (case ("lux try" [(io (do (~! r.Monad<Random>) [] (~ test)))]) - (#.Right (~ g!test)) - (~ g!test) + (~! (IO Test)) + ((~! io) (case ("lux try" ((~! io) ((~! do) + (~! r.Monad<Random>) + [] + (~ test)))) + (#.Right (~ g!test)) + (~ g!test) - (#.Left (~ g!error)) - (..fail (~ g!error)))))))))) + (#.Left (~ g!error)) + (..fail (~ g!error)))))))))) (def: (exported-tests module-name) (-> Text (Meta (List [Text Text Text]))) @@ -225,30 +228,31 @@ tests) num-tests (list.size tests+) groups (list.split-all promise.concurrency-level tests+)]] - (wrap (list (` (: (IO Unit) - (io (exec (do Monad<Promise> - [(~' #let) [(~ g!total-successes) +0 - (~ g!total-failures) +0] - (~+ (list/join (list/map (function [group] - (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) - (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) - (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))]))) - groups)))] - (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] - (log! ($_ (~ g!text/compose) - "Test-suite finished." - "\n" - ((~! %i) (nat-to-int (~ g!total-successes))) - " out of " - ((~! %i) (nat-to-int (n/+ (~ g!total-failures) - (~ g!total-successes)))) - " tests passed." - "\n" - ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed."))) - (promise.future (if (n/> +0 (~ g!total-failures)) - (~! ..die) - (~! ..exit))))) - []))))))))) + (wrap (list (` (: (~! (IO Unit)) + ((~! io) (exec ((~! do) (~! promise.Monad<Promise>) + [(~' #let) [(~ g!total-successes) +0 + (~ g!total-failures) +0] + (~+ (list/join (list/map (function [group] + (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) + (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) + (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))]))) + groups)))] + (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] + (log! ($_ (~ g!text/compose) + "Test-suite finished." + "\n" + ((~! %i) (nat-to-int (~ g!total-successes))) + " out of " + ((~! %i) (nat-to-int (n/+ (~ g!total-failures) + (~ g!total-successes)))) + " tests passed." + "\n" + ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed."))) + ((~! promise.future) + (if (n/> +0 (~ g!total-failures)) + (~! ..die) + (~! ..exit))))) + []))))))))) (def: #export (seq left right) {#.doc "Sequencing combinator."} @@ -256,7 +260,7 @@ (do r.Monad<Random> [left left right right] - (wrap (do Monad<Promise> + (wrap (do promise.Monad<Promise> [[l-counter l-documentation] left [r-counter r-documentation] right] (wrap [(add-counters l-counter r-counter) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 8bd3a1ee5..f5c5fd2f1 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -2,7 +2,6 @@ lux lux/test (lux (control ["M" monad #+ do Monad]) - [io] [math] ["r" math/random] (data [maybe] diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index ad43cadfe..9a0fedbb8 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -1,9 +1,6 @@ (.module: lux - (lux (control monad) - [io] - (concurrency [promise]) - [cli #+ program:] + (lux [cli #+ program:] [test]) (test ["_." lux] (lux ["_." cli] |