diff options
| author | Eduardo Julian | 2021-07-10 03:10:43 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-07-10 03:10:43 -0400 |
| commit | 4610968193df10af12c91f699fec39aeb3ef703a (patch) | |
| tree | 27d1578548ad49f5aefe76fb696a7af10361c9cf | |
| parent | f3e869d0246e956399ec31a074c6c6299ff73602 (diff) | |
Made the "try" macro into a common one, instead of a host-specific one.
68 files changed, 715 insertions, 361 deletions
diff --git a/commands.md b/commands.md index 66256461f..df846461e 100644 --- a/commands.md +++ b/commands.md @@ -44,62 +44,6 @@ cd ~/lux/jbe/bin/ \ --- -# Standard Library - -## Test - -``` -cd ~/lux/stdlib/ \ -&& lein clean \ -&& lein with-profile bibliotheca lux auto test -``` - -## Deploy - -``` -cd ~/lux/stdlib/ && lein install - -cd ~/lux/stdlib/ && mvn install:install-file -Dfile=target/library.tar -DgroupId=com.github.luxlang -DartifactId=stdlib -Dversion=0.6.0-SNAPSHOT -Dpackaging=tar - -cd ~/lux/stdlib/ && mvn deploy:deploy-file \ --Durl=https://<username>:<password>@oss.sonatype.org/content/repositories/snapshots/ \ --Dfile=target/library.tar \ --DgroupId=com.github.luxlang \ --DartifactId=stdlib \ --Dversion=0.6.0-SNAPSHOT \ --Dpackaging=tar -``` - -## Generate documentation - -``` -cd ~/lux/stdlib/ \ -&& lein clean \ -&& lein with-profile scriptum lux auto build -``` - ---- - -# Aedifex: Build system - -## Build - -``` -cd ~/lux/stdlib/ \ -&& lein clean \ -&& lein with-profile aedifex lux auto build -``` - -## Test - -``` -cd ~/lux/stdlib/ \ -&& lein clean \ -&& lein with-profile aedifex lux auto test -``` - ---- - # Leiningen plugin ## Install diff --git a/documentation/bookmark/Cache.md b/documentation/bookmark/Cache.md deleted file mode 100644 index cba5d6826..000000000 --- a/documentation/bookmark/Cache.md +++ /dev/null @@ -1,4 +0,0 @@ -# Reference - -1. https://github.com/eko/gocache - diff --git a/documentation/bookmark/cache.md b/documentation/bookmark/cache.md new file mode 100644 index 000000000..529b43255 --- /dev/null +++ b/documentation/bookmark/cache.md @@ -0,0 +1,5 @@ +# Reference + +1. [Ring - Cache interface as a programming language integration](https://ring-cache.readthedocs.io/en/stable/) +1. https://github.com/eko/gocache + diff --git a/documentation/bookmark/comonad.md b/documentation/bookmark/comonad.md new file mode 100644 index 000000000..f7f9886c1 --- /dev/null +++ b/documentation/bookmark/comonad.md @@ -0,0 +1,4 @@ +# Reference + +1. [Functional Flocks](https://ec-jones.github.io/flocking.html) + diff --git a/documentation/bookmark/compiler.md b/documentation/bookmark/compiler.md new file mode 100644 index 000000000..326bfff9b --- /dev/null +++ b/documentation/bookmark/compiler.md @@ -0,0 +1,8 @@ +# Security + +1. [A Brief Tour of Formally Secure Compilation](http://ceur-ws.org/Vol-2315/paper03.pdf) + +# Framework + +1. [Nanopass Framework: Clean Compiler Creation Language](http://nanopass.org/) + diff --git a/documentation/bookmark/constraint/memory.md b/documentation/bookmark/constraint/memory.md new file mode 100644 index 000000000..e255f5a0b --- /dev/null +++ b/documentation/bookmark/constraint/memory.md @@ -0,0 +1,4 @@ +# Reference + +1. [Small Memory Software: Patterns for systems with limited memory](http://smallmemory.com/) + diff --git a/documentation/bookmark/data_structure.md b/documentation/bookmark/data_structure.md new file mode 100644 index 000000000..ebf7070e2 --- /dev/null +++ b/documentation/bookmark/data_structure.md @@ -0,0 +1,6 @@ +# Reference + +1. [6.851: Advanced Data Structures (Spring'21)](https://courses.csail.mit.edu/6.851/spring21/) +1. [An Efficient Representation for Sparse Sets](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.30.7319&rep=rep1&type=pdf) +1. [Red-black tree implementation notes](http://jstimpfle.de/blah/rbtree/main.html) + diff --git a/documentation/bookmark/database/lock.md b/documentation/bookmark/database/lock.md new file mode 100644 index 000000000..c68ba5f64 --- /dev/null +++ b/documentation/bookmark/database/lock.md @@ -0,0 +1,4 @@ +# Reference + +1. [Progressive Locks : fast, upgradable read/write locks](http://wtarreau.blogspot.com/2018/02/progressive-locks-fast-upgradable.html) + diff --git a/documentation/bookmark/debugging.md b/documentation/bookmark/debugging.md index 8fb385ed6..d2fe2693d 100644 --- a/documentation/bookmark/debugging.md +++ b/documentation/bookmark/debugging.md @@ -31,6 +31,7 @@ # Reference +1. [Debugging in Clojure](https://blog.davemartin.me/posts/debugging-in-clojure/) 1. [The Debugging Book: Tools and Techniques for Automated Software Debugging](https://www.debuggingbook.org/) 1. [The Power Of Collaborative Debugging](https://robert.ocallahan.org/2019/11/the-power-of-collaborative-debugging.html) 1. [Multiverse Debugging: Non-Deterministic Debugging for Non-Deterministic Programs](https://stefan-marr.de/2019/07/what-if-we-could-see-all-concurrency-bugs-in-the-debugger/) diff --git a/documentation/bookmark/exception.md b/documentation/bookmark/exception.md new file mode 100644 index 000000000..e47382a77 --- /dev/null +++ b/documentation/bookmark/exception.md @@ -0,0 +1,4 @@ +# Reference + +1. [You don't understand exceptions, but you should](https://matt.might.net/articles/implementing-exceptions/) + diff --git a/documentation/bookmark/floating point.md b/documentation/bookmark/floating point.md deleted file mode 100644 index 93921b0a9..000000000 --- a/documentation/bookmark/floating point.md +++ /dev/null @@ -1,8 +0,0 @@ -# Reference - -1. [What aspect of portable floating point did Java back down on?](https://retrocomputing.stackexchange.com/questions/18143/what-aspect-of-portable-floating-point-did-java-back-down-on) - -# Algorithm - -1. [Kahan summation algorithm](https://en.wikipedia.org/wiki/Kahan_summation_algorithm) - diff --git a/documentation/bookmark/floating_point.md b/documentation/bookmark/floating_point.md new file mode 100644 index 000000000..55c84d2f2 --- /dev/null +++ b/documentation/bookmark/floating_point.md @@ -0,0 +1,20 @@ +# Random generation + +1. [Uniform random floats: How to generate a double-precision floating-point number in [0, 1] uniformly at random given a uniform random source of bits](https://mumble.net/~campbell/2014/04/28/uniform-random-float) + +# Correctness + +1. [Herbie: Find and fix floating-point problems.](https://herbie.uwplse.org/) + +# Format + +1. [decimal128 floating-point format](https://en.wikipedia.org/wiki/Decimal128_floating-point_format) + +# Reference + +1. [What aspect of portable floating point did Java back down on?](https://retrocomputing.stackexchange.com/questions/18143/what-aspect-of-portable-floating-point-did-java-back-down-on) + +# Algorithm + +1. [Kahan summation algorithm](https://en.wikipedia.org/wiki/Kahan_summation_algorithm) + diff --git a/documentation/bookmark/game_programming.md b/documentation/bookmark/game_programming.md index be969f87d..483c9b356 100644 --- a/documentation/bookmark/game_programming.md +++ b/documentation/bookmark/game_programming.md @@ -178,6 +178,7 @@ # Entity Component System (ECS) +1. [Why Vanilla ECS Is Not Enough](https://ajmmertens.medium.com/why-vanilla-ecs-is-not-enough-d7ed4e3bebe5) 1. [On DOTS: Entity Component System](https://blogs.unity3d.com/2019/03/08/on-dots-entity-component-system/) 1. http://cowboyprogramming.com/2007/01/05/evolve-your-heirachy/ 1. [Bob Nystrom - Is There More to Game Architecture than ECS?](https://www.youtube.com/watch?v=JxI3Eu5DPwE) diff --git a/documentation/bookmark/inspiration.md b/documentation/bookmark/inspiration.md index dfef668ad..be02d1bd7 100644 --- a/documentation/bookmark/inspiration.md +++ b/documentation/bookmark/inspiration.md @@ -1,3 +1,16 @@ +# Tool + +1. [Toward the next generation of programming tools: Programmers have built great tools for others. It’s time they built some for themselves.](https://www.oreilly.com/radar/toward-the-next-generation-of-programming-tools/) + +# Software engineering + +1. [8LU - Are we *really* engineers? by Hillel Wayne](https://www.youtube.com/watch?v=3018ABlET1Y) + +# Human-machine interaction + +1. [How a computer should talk to people](https://moscow.sci-hub.se/3290/2c0a7f4bb78d9f9521ad2d2e92463d5f/dean1982.pdf) +1. [The Tyranny of the Minimum Viable User](https://old.reddit.com/r/dredmorbius/comments/69wk8y/the_tyranny_of_the_minimum_viable_user/) + # Possibility 1. [Lambda World 2018 - What FP can learn from Smalltalk by Aditya Siram](https://www.youtube.com/watch?v=baxtyeFVn3w) @@ -28,3 +41,7 @@ 1. [The dark side of ergonomics](https://vorner.github.io/2018/04/08/Dark-side-of-ergonomics.html) 1. []() +# Robustness + +1. [Volatile Software](https://stevelosh.com/blog/2012/04/volatile-software/) + diff --git a/documentation/bookmark/logging.md b/documentation/bookmark/logging.md new file mode 100644 index 000000000..cb4cc64ed --- /dev/null +++ b/documentation/bookmark/logging.md @@ -0,0 +1,5 @@ +# Reference + +1. [IceCream — Never use print() to debug again](https://github.com/gruns/icecream) +1. [Capabilities of Elixir's Logger](https://blog.appsignal.com/2020/10/13/capabilities-of-elixir-logger.html) + diff --git a/documentation/bookmark/multiple_dispatch.md b/documentation/bookmark/multiple_dispatch.md new file mode 100644 index 000000000..0dfb33200 --- /dev/null +++ b/documentation/bookmark/multiple_dispatch.md @@ -0,0 +1,4 @@ +# Reference + +1. [JuliaCon 2019 | The Unreasonable Effectiveness of Multiple Dispatch | Stefan Karpinski](https://www.youtube.com/watch?v=kc9HwsxE1OY) + diff --git a/documentation/bookmark/optimization.md b/documentation/bookmark/optimization.md index f94497546..fe23c3e2a 100644 --- a/documentation/bookmark/optimization.md +++ b/documentation/bookmark/optimization.md @@ -1,3 +1,11 @@ +# Arithmetic + +1. [Labor of Division (Episode I)](https://ridiculousfish.com/blog/posts/labor-of-division-episode-i.html) + +# Compilation + +1. [Future Directions for Optimizing Compilers](https://arxiv.org/abs/1809.02161) + # Pre-fetching 1. [Prefetching in Functional Languages](https://www.cl.cam.ac.uk/~tmj32/papers/docs/ainsworth20-ismm.pdf) @@ -40,3 +48,7 @@ 1. [Loop Optimizations in LLVM - Michael Kruse](https://www.youtube.com/watch?v=oAPgGYr8T3Y) 1. [Don’t think, just defunctionalize](https://www.joachim-breitner.de/blog/778-Don%E2%80%99t_think%2C_just_defunctionalize) +# JavaScript + +1. [Javascript Array.push is 945x faster than Array.concat](https://dev.to/uilicious/javascript-array-push-is-945x-faster-than-array-concat-1oki) + diff --git a/documentation/bookmark/packaging.md b/documentation/bookmark/packaging.md new file mode 100644 index 000000000..cbfaba779 --- /dev/null +++ b/documentation/bookmark/packaging.md @@ -0,0 +1,4 @@ +# Reference + +1. [Open Sourcing Metapod, Personalized Executable for All.](https://rainway.com/blog/2019/05/14/open-source-metapod/) + diff --git a/documentation/bookmark/partial_evaluation.md b/documentation/bookmark/partial_evaluation.md new file mode 100644 index 000000000..922982219 --- /dev/null +++ b/documentation/bookmark/partial_evaluation.md @@ -0,0 +1,4 @@ +# Reference + +1. [Partial Evaluation and Automatic Program Generation](https://www.itu.dk/~sestoft/pebook/pebook.html) + diff --git a/documentation/bookmark/platform/jvm.md b/documentation/bookmark/platform/jvm.md index 2ed871a36..db2b13a6c 100644 --- a/documentation/bookmark/platform/jvm.md +++ b/documentation/bookmark/platform/jvm.md @@ -1,4 +1,5 @@ # Reference +1. [JVM Internals](https://blog.jamesdbloom.com/JVMInternals.html) 1. [JVM Anatomy Quarks](https://shipilev.net/jvm/anatomy-quarks/) diff --git a/documentation/bookmark/plugin.md b/documentation/bookmark/plugin.md new file mode 100644 index 000000000..41ee56658 --- /dev/null +++ b/documentation/bookmark/plugin.md @@ -0,0 +1,4 @@ +# Reference + +1. [How to build a plugin system on the web and also sleep well at night](https://www.figma.com/blog/how-we-built-the-figma-plugin-system/) + diff --git a/documentation/bookmark/process.md b/documentation/bookmark/process.md index 448461579..5c08d58cf 100644 --- a/documentation/bookmark/process.md +++ b/documentation/bookmark/process.md @@ -1,4 +1,6 @@ # Reference +1. [Get your work recognized: write a brag document](https://jvns.ca/blog/brag-documents/) +1. [Danger: Formalize your Pull Request etiquette.](https://github.com/danger/danger) 1. [No code reviews by default](https://raycast.com/blog/no-code-reviews-by-default/) diff --git a/documentation/bookmark/program_verification.md b/documentation/bookmark/program_verification.md new file mode 100644 index 000000000..12ed44865 --- /dev/null +++ b/documentation/bookmark/program_verification.md @@ -0,0 +1,4 @@ +# Domain Theory + +1. [Domain Theory: the forgotten step in program verification](https://bertrandmeyer.com/2012/04/11/domain-theory-the-forgotten-step-in-program-verification/) + diff --git a/documentation/bookmark/random_generation.md b/documentation/bookmark/random_generation.md new file mode 100644 index 000000000..408d5da32 --- /dev/null +++ b/documentation/bookmark/random_generation.md @@ -0,0 +1,4 @@ +# Reference + +1. [Efficiently Generating a Number in a Range](https://www.pcg-random.org/posts/bounded-rands.html) + diff --git a/documentation/bookmark/rendering.md b/documentation/bookmark/rendering.md new file mode 100644 index 000000000..7ee38f83d --- /dev/null +++ b/documentation/bookmark/rendering.md @@ -0,0 +1,4 @@ +# Reference + +1. [Geometry Types for Graphics Programming](https://www.cs.cornell.edu/~asampson/media/papers/gator-oopsla2020-preprint.pdf) + diff --git a/documentation/bookmark/security.md b/documentation/bookmark/security.md index 6439b9e20..32a5a7d90 100644 --- a/documentation/bookmark/security.md +++ b/documentation/bookmark/security.md @@ -1,5 +1,14 @@ -# Secrets +# Memory +1. [Provably Safe Pointers for a Parallel World](https://www.youtube.com/watch?v=ugf58HNd7Rg) + +# User/human-level + +1. [Security Checklist: Tools and resources designed to improve your online privacy, safety, and security.](https://brianlovin.com/security) + +# Secrets | Confidentiality + +1. [ConfLLVM: A Compiler for Enforcing Data Confidentiality in Low-level Code](https://www.microsoft.com/en-us/research/publication/an-instrumenting-compiler-for-enforcing-confidentiality-in-low-level-code/) 1. [How to Handle Secrets on the Command Line](https://smallstep.com/blog/command-line-secrets/) # Capability diff --git a/documentation/bookmark/type_theory/quantitative.md b/documentation/bookmark/type_theory/quantitative.md new file mode 100644 index 000000000..0c2fd800c --- /dev/null +++ b/documentation/bookmark/type_theory/quantitative.md @@ -0,0 +1,4 @@ +# Reference + +1. [The Syntax and Semantics of Quantitative Type Theory](https://bentnib.org/quantitative-type-theory.html) + diff --git a/documentation/bookmark/user_interface/accessibility.md b/documentation/bookmark/user_interface/accessibility.md new file mode 100644 index 000000000..5a0645773 --- /dev/null +++ b/documentation/bookmark/user_interface/accessibility.md @@ -0,0 +1,4 @@ +# Reference + +1. [Nobody talks about the real reason to use Tabs over Spaces](https://www.reddit.com/r/javascript/comments/c8drjo/nobody_talks_about_the_real_reason_to_use_tabs/?st=jxuy98ok&sh=8487bdfa) + diff --git a/documentation/bookmark/user_interface/color.md b/documentation/bookmark/user_interface/color.md index 512a49f1a..80595d1b1 100644 --- a/documentation/bookmark/user_interface/color.md +++ b/documentation/bookmark/user_interface/color.md @@ -1,5 +1,6 @@ # Reference +1. [CSS Gradient Fixer](https://www.da.vidbuchanan.co.uk/widgets/css-gradient-fixer/) 1. [Towards richer colors on the Web](https://darker.ink/writings/Towards-richer-colors-on-the-Web) 1. [How software gets color wrong](https://bottosson.github.io/posts/colorwrong/) diff --git a/lux-bootstrapper/src/lux/analyser/proc/common.clj b/lux-bootstrapper/src/lux/analyser/proc/common.clj index 3f89b0ee4..439ad0d10 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/common.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/common.clj @@ -22,7 +22,7 @@ (&type/with-var (fn [$var] (|do [:let [(&/$Cons op (&/$Nil)) ?values] - =op (&&/analyse-1 analyse (&/$Apply $var &type/IO) op) + =op (&&/analyse-1 analyse (&/$Function &type/Any $var) op) _ (&type/check exo-type (&/$Sum &type/Text ;; lux.Left $var ;; lux.Right )) diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 52e923892..43ced94d8 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -498,19 +498,19 @@ @.js (as_is (def: (eval code) - (-> Text (Maybe Any)) + (-> Text (Try (Maybe Any))) ## Note: I have to call "eval" this way ## in order to avoid a quirk of calling eval in Node ## when the code is running under "use strict";. - (let [return ("js apply" (function.identity ("js constant" "eval")) code)] - (if ("js object null?" return) - #.None - (#.Some return)))) + (try (let [return ("js apply" (function.identity ("js constant" "eval")) code)] + (if ("js object null?" return) + #.None + (#.Some return))))) (def: (evaluate! alias input) (-> Context _.Expression (Try Any)) (do try.monad - [?output (ffi.try (..eval (_.code input)))] + [?output (..eval (_.code input))] (case ?output (#.Some output) (wrap output) @@ -521,7 +521,7 @@ (def: (execute! input) (-> _.Statement (Try Any)) (do try.monad - [?output (ffi.try (..eval (_.code input)))] + [?output (..eval (_.code input))] (wrap []))) (def: (define! context input) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index efc4a0d0c..95de82463 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type int char) + [lux (#- Type int char try) ["." ffi (#+ import: do_to)] [abstract [monad (#+ do)]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index 95cfd9e5a..cd719679d 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type) + [lux (#- Type try) [abstract [monad (#+ do)] ["." enum]] diff --git a/stdlib/commands.md b/stdlib/commands.md new file mode 100644 index 000000000..29af59778 --- /dev/null +++ b/stdlib/commands.md @@ -0,0 +1,54 @@ +# Standard Library + +## Test + +``` +cd ~/lux/stdlib/ \ +&& lein clean \ +&& lein with-profile bibliotheca lux auto test +``` + +## Deploy + +``` +cd ~/lux/stdlib/ && lein install + +cd ~/lux/stdlib/ && mvn install:install-file -Dfile=target/library.tar -DgroupId=com.github.luxlang -DartifactId=stdlib -Dversion=0.6.0-SNAPSHOT -Dpackaging=tar + +cd ~/lux/stdlib/ && mvn deploy:deploy-file \ +-Durl=https://<username>:<password>@oss.sonatype.org/content/repositories/snapshots/ \ +-Dfile=target/library.tar \ +-DgroupId=com.github.luxlang \ +-DartifactId=stdlib \ +-Dversion=0.6.0-SNAPSHOT \ +-Dpackaging=tar +``` + +## Generate documentation + +``` +cd ~/lux/stdlib/ \ +&& lein clean \ +&& lein with-profile scriptum lux auto build +``` + +--- + +# Aedifex: Build system + +## Build + +``` +cd ~/lux/stdlib/ \ +&& lein clean \ +&& lein with-profile aedifex lux auto build +``` + +## Test + +``` +cd ~/lux/stdlib/ \ +&& lein clean \ +&& lein with-profile aedifex lux auto test +``` + diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index be6755ebe..d4e8efda6 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5907,3 +5907,21 @@ _ (..fail (..wrong_syntax_error (name_of ..:let))))) + +(macro: #export (try tokens) + {#.doc (doc (case (try (risky_computation input)) + (#.Right success) + (do_something success) + + (#.Left error) + (recover_from_failure error)))} + (case tokens + (^ (list expression)) + (do meta_monad + [g!_ (gensym "g!_")] + (wrap (list (` ("lux try" + (.function ((~ g!_) (~ g!_)) + (~ expression))))))) + + _ + (..fail (..wrong_syntax_error (name_of ..try))))) diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 0ab73684c..d6dc71c37 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -9,8 +9,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO io)]] [data - ["." text - ["%" format (#+ format)]] + ["." text] [collection ["." list]]] [math @@ -89,11 +88,12 @@ (def: (execute! action) (-> (IO Any) Any) - (case ("lux try" action) + (case (try (io.run action)) (#try.Failure error) (exec - ("lux io log" (format "ERROR DURING THREAD EXECUTION:" text.new_line - error)) + ("lux io log" ($_ "lux text concat" + "ERROR DURING THREAD EXECUTION:" text.new_line + error)) []) (#try.Success _) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 4c95b5ee6..fb8e856ae 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -76,146 +76,144 @@ (#try.Success [input []]) (#try.Failure message)))) -(def: #export (maybe p) +(def: #export (maybe parser) {#.doc "Optionality combinator."} (All [s a] (-> (Parser s a) (Parser s (Maybe a)))) (function (_ input) - (case (p input) + (case (parser input) (#try.Failure _) (#try.Success [input #.None]) (#try.Success [input' x]) (#try.Success [input' (#.Some x)])))) -(def: #export (run p input) +(def: #export (run parser input) (All [s a] (-> (Parser s a) s (Try [s a]))) - (p input)) + (parser input)) -(def: #export (some parser) - {#.doc "0-or-more combinator."} - (All [s a] - (-> (Parser s a) (Parser s (List a)))) - (function (_ input) - (case (parser input) - (#try.Failure _) - (#try.Success [input (list)]) - - (#try.Success [input' head]) - (run (\ ..monad map (|>> (list& head)) - (some parser)) - input')))) - -(def: #export (many parser) - {#.doc "1-or-more combinator."} - (All [s a] - (-> (Parser s a) (Parser s (List a)))) - (do {! ..monad} - [head parser] - (\ ! map (|>> (list& head)) - (some parser)))) - -(def: #export (and p1 p2) +(def: #export (and first second) {#.doc "Sequencing combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s [a b]))) - (do ..monad - [x1 p1 - x2 p2] - (wrap [x1 x2]))) + (do {! ..monad} + [head first] + (\ ! map (|>> [head]) second))) -(def: #export (or p1 p2) +(def: #export (or left right) {#.doc "Heterogeneous alternative combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s (| a b)))) (function (_ tokens) - (case (p1 tokens) - (#try.Success [tokens' x1]) - (#try.Success [tokens' (0 #0 x1)]) + (case (left tokens) + (#try.Success [tokens' output]) + (#try.Success [tokens' (0 #0 output)]) (#try.Failure _) - (run (do ..monad - [x2 p2] - (wrap (0 #1 x2))) - tokens) - ))) + (case (right tokens) + (#try.Success [tokens' output]) + (#try.Success [tokens' (0 #1 output)]) + + (#try.Failure error) + (#try.Failure error))))) -(def: #export (either pl pr) +(def: #export (either this that) {#.doc "Homogeneous alternative combinator."} (All [s a] (-> (Parser s a) (Parser s a) (Parser s a))) (function (_ tokens) - (case (pl tokens) + (case (this tokens) (#try.Failure _) - (pr tokens) + (that tokens) output - output - ))) + output))) -(def: #export (exactly n p) +(def: #export (some parser) + {#.doc "0-or-more combinator."} + (All [s a] + (-> (Parser s a) (Parser s (List a)))) + (function (_ input) + (case (parser input) + (#try.Failure _) + (#try.Success [input (list)]) + + (#try.Success [input' head]) + (..run (\ ..monad map (|>> (list& head)) + (some parser)) + input')))) + +(def: #export (many parser) + {#.doc "1-or-more combinator."} + (All [s a] + (-> (Parser s a) (Parser s (List a)))) + (|> (..some parser) + (..and parser) + (\ ..monad map (|>> #.Cons)))) + +(def: #export (exactly amount parser) {#.doc "Parse exactly N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) - (if (n.> 0 n) - (do ..monad - [x p - xs (exactly (dec n) p)] - (wrap (#.Cons x xs))) - (\ ..monad wrap (list)))) - -(def: #export (at_least n p) + (case amount + 0 (\ ..monad wrap (list)) + _ (do {! ..monad} + [x parser] + (|> parser + (exactly (dec amount)) + (\ ! map (|>> (#.Cons x))))))) + +(def: #export (at_least amount parser) {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) - (do ..monad - [min (exactly n p) - extra (some p)] - (wrap (list\compose min extra)))) + (do {! ..monad} + [minimum (..exactly amount parser)] + (\ ! map (list\compose minimum) (..some parser)))) -(def: #export (at_most n p) +(def: #export (at_most amount parser) {#.doc "Parse at most N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) - (if (n.> 0 n) - (function (_ input) - (case (p input) - (#try.Failure msg) - (#try.Success [input (list)]) + (case amount + 0 (\ ..monad wrap (list)) + _ (function (_ input) + (case (parser input) + (#try.Failure msg) + (#try.Success [input (list)]) - (#try.Success [input' x]) - (run (do ..monad - [xs (at_most (dec n) p)] - (wrap (#.Cons x xs))) - input') - )) - (\ ..monad wrap (list)))) + (#try.Success [input' x]) + (..run (\ ..monad map (|>> (#.Cons x)) + (at_most (dec amount) parser)) + input'))))) -(def: #export (between from to p) +(def: #export (between from to parser) {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) - (do ..monad - [min_xs (exactly from p) - max_xs (at_most (n.- from to) p)] - (wrap (\ list.monad join (list min_xs max_xs))))) - -(def: #export (sep_by sep p) - {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} + (do {! ..monad} + [minimum (..exactly from parser)] + (if (n.< to from) + (\ ! map (list\compose minimum) + (..at_most (n.- from to) parser)) + (wrap minimum)))) + +(def: #export (separated_by separator parser) + {#.doc "Parsers instances of 'parser' that are separated by instances of 'separator'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do {! ..monad} - [?x (maybe p)] + [?x (..maybe parser)] (case ?x #.None (wrap #.Nil) (#.Some x) - (do ! - [xs' (some (..and sep p))] - (wrap (#.Cons x (list\map product.right xs')))) - ))) + (|> parser + (..and separator) + ..some + (\ ! map (|>> (list\map product.right) (#.Cons x))))))) -(def: #export (not p) +(def: #export (not parser) (All [s a] (-> (Parser s a) (Parser s Any))) (function (_ input) - (case (p input) + (case (parser input) (#try.Failure msg) (#try.Success [input []]) @@ -257,7 +255,7 @@ {#.doc "Combinator for recursive parser."} (All [s a] (-> (-> (Parser s a) (Parser s a)) (Parser s a))) (function (_ inputs) - (run (parser (rec parser)) inputs))) + (..run (parser (rec parser)) inputs))) (def: #export (after param subject) (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 49a06824c..a9986822f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -393,7 +393,7 @@ (do <>.monad [_ (<text>.this <open>) _ parse_space - elems (<>.sep_by ..parse_separator <elem_parser>) + elems (<>.separated_by ..parse_separator <elem_parser>) _ parse_space _ (<text>.this <close>)] (wrap (<prep> elems))))] diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 5d4252cfc..4097d1171 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -98,14 +98,11 @@ (def: tag^ namespaced_symbol^) (def: attr_name^ namespaced_symbol^) -(def: white_space^ - (Parser Text) - (<text>.some <text>.space)) - (def: spaced^ (All [a] (-> (Parser a) (Parser a))) - (|>> (<>.before ..white_space^) - (<>.after ..white_space^))) + (let [white_space^ (<>.some <text>.space)] + (|>> (<>.before white_space^) + (<>.after white_space^)))) (def: attr_value^ (Parser Text) @@ -173,25 +170,23 @@ [_ (<text>.this "<") tag (..spaced^ tag^) attrs (..spaced^ attrs^) - #let [no_children^ (do <>.monad - [_ (<text>.this "/>")] - (wrap (#Node tag attrs (list)))) - ## TODO: Find a way to make do without this hack. Without it, some POM files fail when parsing them in Aedifex. Something like this fails: <configuration> </configuration> - alternative_no_children^ (do <>.monad - [_ (<text>.this ">") - _ (<>.some <text>.space) - _ (..close_tag^ tag)] - (wrap (#Node tag attrs (list)))) + #let [no_children^ ($_ <>.either + (do <>.monad + [_ (<text>.this "/>")] + (wrap (#Node tag attrs (list)))) + (do <>.monad + [_ (<text>.this ">") + _ (<>.some (<>.either <text>.space + ..comment^)) + _ (..close_tag^ tag)] + (wrap (#Node tag attrs (list))))) with_children^ (do <>.monad [_ (<text>.this ">") - children (<>.either (<>.many node^) - (<>.after (<>.some ..comment^) - (wrap (: (List XML) (list))))) + children (<>.many node^) _ (..close_tag^ tag)] (wrap (#Node tag attrs children)))]] ($_ <>.either no_children^ - alternative_no_children^ with_children^)) ..spaced^ (<>.before (<>.some ..comment^)) diff --git a/stdlib/source/lux/data/text/encoding/utf8.lux b/stdlib/source/lux/data/text/encoding/utf8.lux index 6f84dfa64..84e0092c8 100644 --- a/stdlib/source/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/lux/data/text/encoding/utf8.lux @@ -133,7 +133,7 @@ #try.Success)) @.python - (ffi.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8"))) + (try (:coerce Text ("python object do" "decode" (:assume value) "utf-8"))) @.lua (#try.Success ("lua utf8 decode" value)) diff --git a/stdlib/source/lux/ffi.js.lux b/stdlib/source/lux/ffi.js.lux index 0e0172a61..0625769cf 100644 --- a/stdlib/source/lux/ffi.js.lux +++ b/stdlib/source/lux/ffi.js.lux @@ -172,15 +172,6 @@ (<>.some member))))) (<code>.form ..common_method))) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (def: (with_io with? without) (-> Bit Code Code) (if with? @@ -196,7 +187,7 @@ (def: (with_try with? without_try) (-> Bit Code Code) (if with? - (` (..try (~ without_try))) + (` (.try (~ without_try))) without_try)) (def: (try_type try? rawT) diff --git a/stdlib/source/lux/ffi.jvm.lux b/stdlib/source/lux/ffi.jvm.lux index 34c33f1d2..c6187e73b 100644 --- a/stdlib/source/lux/ffi.jvm.lux +++ b/stdlib/source/lux/ffi.jvm.lux @@ -1311,15 +1311,6 @@ ("jvm object null")} (~ expr))))))) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (syntax: #export (check {class (..type^ (list))} {unchecked (<>.maybe <code>.any)}) {#.doc (doc "Checks whether an object is an instance of a particular class." @@ -1453,7 +1444,7 @@ _ return_term))] - [decorate_return_try #import_member_try? (` (..try (~ return_term)))] + [decorate_return_try #import_member_try? (` (.try (~ return_term)))] [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] ) @@ -1705,7 +1696,7 @@ (|>> (:coerce (primitive "java.lang.String")) ["Ljava/lang/String;"] ("jvm member invoke static" [] "java.lang.Class" "forName" []) - ..try)) + try)) (def: (class_kind declaration) (-> (Type Declaration) (Meta Class_Kind)) diff --git a/stdlib/source/lux/ffi.lua.lux b/stdlib/source/lux/ffi.lua.lux index 519c32fdf..946c6153a 100644 --- a/stdlib/source/lux/ffi.lua.lux +++ b/stdlib/source/lux/ffi.lua.lux @@ -170,15 +170,6 @@ ..constant )) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (def: (with_io with? without) (-> Bit Code Code) (if with? @@ -194,7 +185,7 @@ (def: (with_try with? without_try) (-> Bit Code Code) (if with? - (` (..try (~ without_try))) + (` (.try (~ without_try))) without_try)) (def: (try_type try? rawT) diff --git a/stdlib/source/lux/ffi.old.lux b/stdlib/source/lux/ffi.old.lux index 6c01ccf3a..aa3252fc3 100644 --- a/stdlib/source/lux/ffi.old.lux +++ b/stdlib/source/lux/ffi.old.lux @@ -1309,15 +1309,6 @@ ("jvm object null")} (~ expr))))))) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (syntax: #export (check {class (..generic_type^ (list))} {unchecked (<>.maybe <code>.any)}) {#.doc (doc "Checks whether an object is an instance of a particular class." @@ -1447,7 +1438,7 @@ _ return_term))] - [decorate_return_try #import_member_try? (` (..try (~ return_term)))] + [decorate_return_try #import_member_try? (` (.try (~ return_term)))] [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] ) @@ -1645,7 +1636,7 @@ (def: (load_class class_name) (-> Text (Try (java/lang/Class Any))) - (..try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name))) + (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name))) (def: (class_kind [class_name _]) (-> Class_Declaration (Meta Class_Kind)) diff --git a/stdlib/source/lux/ffi.py.lux b/stdlib/source/lux/ffi.py.lux index 865683dc6..bf8e5facf 100644 --- a/stdlib/source/lux/ffi.py.lux +++ b/stdlib/source/lux/ffi.py.lux @@ -170,15 +170,6 @@ (<>.some member))))) (<code>.form ..common_method))) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (def: (with_io with? without) (-> Bit Code Code) (if with? @@ -194,7 +185,7 @@ (def: (with_try with? without_try) (-> Bit Code Code) (if with? - (` (..try (~ without_try))) + (` (.try (~ without_try))) without_try)) (def: (try_type try? rawT) diff --git a/stdlib/source/lux/ffi.rb.lux b/stdlib/source/lux/ffi.rb.lux index 5e980a41d..4cbc50172 100644 --- a/stdlib/source/lux/ffi.rb.lux +++ b/stdlib/source/lux/ffi.rb.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Alias) - ["." meta] ["@" target] + ["." meta] [abstract [monad (#+ do)]] [control @@ -183,15 +183,6 @@ ..constant ))) -(syntax: #export (try expression) - {#.doc (doc (case (try (risky_computation input)) - (#.Right success) - (do_something success) - - (#.Left error) - (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) - (def: (with_io with? without) (-> Bit Code Code) (if with? @@ -207,7 +198,7 @@ (def: (with_try with? without_try) (-> Bit Code Code) (if with? - (` (..try (~ without_try))) + (` (.try (~ without_try))) without_try)) (def: (try_type try? rawT) diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index 11285ad12..f1a7c3e72 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Location Code or and function if cond undefined for comment not int) + [lux (#- Location Code or and function if cond undefined for comment not int try) [control [pipe (#+ case>)]] [data diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index eb78bc024..503970d6a 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type int) + [lux (#- Type int try) ["." ffi (#+ import:)] [abstract [monoid (#+ Monoid)] diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index 2796a4fb9..f85bf5f03 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Location Code Global static int if cond or and not comment for) + [lux (#- Location Code Global static int if cond or and not comment for try) ["@" target] [abstract [equivalence (#+ Equivalence)] diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 54e524538..8554f48bf 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Location Code not or and list if cond int comment exec) + [lux (#- Location Code not or and list if cond int comment exec try) ["@" target] ["." ffi] [abstract diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index cf951e9a1..f246e0df9 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -13,7 +13,7 @@ ["." atom (#+ Atom)] ["." promise (#+ Promise) ("#\." monad)]] ["<>" parser - ["<c>" code]]] + ["<.>" code]]] [data ["." maybe] ["." product] @@ -101,7 +101,8 @@ [left left] (\ ! map (..and' left) right))) -(def: context_prefix text.tab) +(def: context_prefix + text.tab) (def: #export (context description) (-> Text Test Test) @@ -118,7 +119,7 @@ (def: #export fail (-> Text Test) (|>> (format ..failure_prefix) - [failure] + [..failure] promise\wrap random\wrap)) @@ -133,7 +134,7 @@ (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Test) - (random\wrap (assert message condition))) + (random\wrap (..assert message condition))) (def: #export (lift message random) (-> Text (Random Bit) Test) @@ -286,7 +287,7 @@ (code.tuple (list (code.text (name.module name)) (code.text (name.short name))))) -(syntax: (reference {name <c>.identifier}) +(syntax: (reference {name <code>.identifier}) (do meta.monad [_ (meta.find_export name)] (wrap (list (name_code name))))) @@ -315,7 +316,7 @@ (set.add [module remaining] output)))) (template [<macro> <function>] - [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} + [(syntax: #export (<macro> {coverage (<code>.tuple (<>.many <code>.any))} condition) (let [coverage (list\map (function (_ definition) (` ((~! ..reference) (~ definition)))) @@ -329,7 +330,7 @@ [cover ..|cover|] ) -(syntax: #export (for {coverage (<c>.tuple (<>.many <c>.any))} +(syntax: #export (for {coverage (<code>.tuple (<>.many <code>.any))} test) (let [coverage (list\map (function (_ definition) (` ((~! ..reference) (~ definition)))) @@ -347,7 +348,7 @@ [(update@ #expected_coverage (set.union coverage) tally) documentation])))))) -(syntax: #export (covering {module <c>.identifier} +(syntax: #export (covering {module <code>.identifier} test) (do meta.monad [#let [module (name.module module)] @@ -381,7 +382,7 @@ run! (: (-> Test Assertion) (|>> (random.run prng) product.right - io.io + (function (_ _)) "lux try" (case> (#try.Success output) output diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 17c27fe4f..8c5cbcd09 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -3,11 +3,10 @@ [abstract ["." monad (#+ do)]] [control - [io (#+ IO)] ["." try] ["." exception (#+ exception:)] ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data ["." maybe] ["." text @@ -40,7 +39,7 @@ (-> Text Phase Archive s (Operation Analysis))] Handler)) (function (_ extension_name analyse archive args) - (case (<c>.run syntax args) + (case (<code>.run syntax args) (#try.Success inputs) (handler extension_name analyse archive inputs) @@ -88,7 +87,7 @@ (def: text_char (Parser text.Char) (do <>.monad - [raw <c>.text] + [raw <code>.text] (case (text.size raw) 1 (wrap (|> raw (text.nth 0) maybe.assume)) _ (<>.fail (exception.construct ..char_text_must_be_size_1 [raw]))))) @@ -96,10 +95,10 @@ (def: lux::syntax_char_case! (..custom [($_ <>.and - <c>.any - (<c>.tuple (<>.some (<>.and (<c>.tuple (<>.many ..text_char)) - <c>.any))) - <c>.any) + <code>.any + (<code>.tuple (<>.some (<>.and (<code>.tuple (<>.many ..text_char)) + <code>.any))) + <code>.any) (function (_ extension_name phase archive [input conditionals else]) (do {! ////.monad} [input (typeA.with_type text.Char @@ -140,7 +139,7 @@ (do ////.monad [[var_id varT] (typeA.with_env check.var) _ (typeA.infer (type (Either Text varT))) - opA (typeA.with_type (type (IO varT)) + opA (typeA.with_type (type (-> .Any varT)) (analyse archive opC))] (wrap (#////analysis.Extension extension_name (list opA)))) @@ -194,7 +193,7 @@ (def: (caster input output) (-> Type Type Handler) (..custom - [<c>.any + [<code>.any (function (_ extension_name phase archive valueC) (do {! ////.monad} [_ (typeA.infer output)] @@ -204,7 +203,7 @@ (def: lux::macro Handler (..custom - [<c>.any + [<code>.any (function (_ extension_name phase archive valueC) (do {! ////.monad} [_ (typeA.infer .Macro) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index ec3080fc2..1c31c7ed9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type Definition case false true) + [lux (#- Type Definition case false true try) [abstract ["." monad (#+ do)] ["." enum]] diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 772f57d88..f5ec4caf2 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -17,7 +17,8 @@ [binary (#+ Binary)] ["." text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]] [collection @@ -77,6 +78,8 @@ [resolution (/command/deps.do! console (/repository/local.repository program (file.async file.default)) (..repositories profile) + (|>> (/repository/remote.repository http.default #.None) + /repository.async) profile)] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile))) @@ -172,6 +175,8 @@ (/command/deps.do! console (/repository/local.repository program (file.async file.default)) (..repositories profile) + (|>> (/repository/remote.repository http.default #.None) + /repository.async) profile)) (#/cli.Compilation compilation) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 4dcc9d6e1..e4881986b 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -14,6 +14,7 @@ [text ["%" format]]] [world + [net (#+ URL)] [program (#+ Program)] ["." file] ["." console (#+ Console)]]] @@ -35,12 +36,20 @@ ///artifact.format %.text)) -(def: #export (do! console local remotes profile) - (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution)) +(def: #export (do! console local remotes new_repository profile) + (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (-> URL (Repository Promise)) (Command Resolution)) (do promise.monad [#let [dependencies (set.to_list (get@ #///.dependencies profile))] - [local_successes local_failures cache] (///dependency/resolution.all console (list local) dependencies ///dependency/resolution.empty) - [remote_successes remote_failures resolution] (///dependency/resolution.all console remotes dependencies cache)] + [local_successes local_failures cache] (///dependency/resolution.all console + (list local) + new_repository + dependencies + ///dependency/resolution.empty) + [remote_successes remote_failures resolution] (///dependency/resolution.all console + remotes + new_repository + dependencies + cache)] (do ///action.monad [cached (|> (dictionary.keys cache) (list\fold dictionary.remove resolution) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 63c3e930d..2cbb469ab 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -196,8 +196,8 @@ [_ (..announce_failure console repository (get@ #//.artifact dependency))] (any console alternatives dependency)))))) -(def: #export (all console repositories dependencies resolution) - (-> (Console Promise) (List (Repository Promise)) (List Dependency) Resolution +(def: #export (all console repositories new_repository dependencies resolution) + (-> (Console Promise) (List (Repository Promise)) (-> URL (Repository Promise)) (List Dependency) Resolution (Promise [(List Dependency) (List Dependency) Resolution])) @@ -237,8 +237,7 @@ ///package.repositories (try\map set.to_list) (try.default (list)) - (list\map (|>> (///repository/remote.repository http.default #.None) - ///repository.async)) + (list\map new_repository) (list\compose repositories))] [successes failures resolution] (recur sub_repositories (#.Cons head successes) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index ecb34437a..819495c02 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -103,8 +103,11 @@ (///dependency/deployment.all local)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) - (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) - [])))) + (/.do! console local + (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) + [])) + (function (_ url) + (///repository.mock $///dependency/resolution.nope [])))) #let [had_dependee_before! (set.member? pre dependee_artifact) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 42116844f..6d25ffd4b 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -86,6 +86,16 @@ (\ ///hash.md5_codec encode) (\ utf8.codec encode))) +(def: #export nope + (Mock Any) + (implementation + (def: the_description + "[0]") + (def: (on_download uri state) + (#try.Failure "NOPE")) + (def: (on_upload uri binary state) + (#try.Failure "NOPE")))) + (def: #export (single artifact package) (-> Artifact Package (Mock Any)) (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] @@ -407,6 +417,8 @@ (list (///repository.mock (..single dependee_artifact dependee_package) []) (///repository.mock (..single depender_artifact depender_package) []) (///repository.mock (..single ignored_artifact ignored_package) [])) + (function (_ url) + (///repository.mock ..nope [])) (list depender) /.empty)] (_.cover' [/.all] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index beebb2844..b320841c5 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -38,6 +38,7 @@ ["#." meta] ["#." program] ["#." target] + ["#." test] ["#." time] ## ["#." tool] ## TODO: Update & expand tests for this ["#." type] @@ -209,7 +210,8 @@ (def: sub_tests Test - (with_expansions [<target> (for {@.jvm (~~ (as_is /target/jvm.test)) + (with_expansions [## TODO: Update & expand tests for this + <target> (for {@.jvm (~~ (as_is /target/jvm.test)) @.old (~~ (as_is /target/jvm.test))} (~~ (as_is))) <extension> (for {@.old (~~ (as_is))} @@ -224,6 +226,7 @@ /meta.test /program.test /target.test + /test.test /time.test ## /tool.test /type.test diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 76eb07104..0e31427ee 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -1,7 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." ffi] [abstract [monad (#+ do)]] [control @@ -20,16 +19,16 @@ [expected random.nat]) ($_ _.and (_.cover [/.pre] - (case (ffi.try (/.pre (n.even? expected) - true)) + (case (try (/.pre (n.even? expected) + true)) (#try.Success output) output (#try.Failure error) (not (n.even? expected)))) (_.cover [/.post] - (case (ffi.try (/.post n.odd? - expected)) + (case (try (/.post n.odd? + expected)) (#try.Success actual) (is? expected actual) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index bf69c8330..82ce4e6a4 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -12,7 +12,7 @@ [control ["." try (#+ Try)] [parser - ["s" code]]] + ["<.>" code]]] [data ["." text ("#\." equivalence) ["%" format (#+ format)]] @@ -96,44 +96,44 @@ ($_ _.and (_.cover [/.maybe] (and (|> (list (code.nat expected0)) - (/.run (/.maybe s.nat)) + (/.run (/.maybe <code>.nat)) (match (#.Some actual) (n.= expected0 actual))) (|> (list (code.int (.int expected0))) - (/.run (/.maybe s.nat)) + (/.run (/.maybe <code>.nat)) (match #.None #1)))) (_.cover [/.some] (and (|> (list\map code.nat expected+) - (/.run (/.some s.nat)) + (/.run (/.some <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))) (|> (list\map (|>> .int code.int) expected+) - (/.run (/.some s.nat)) + (/.run (/.some <code>.nat)) (match #.Nil #1)))) (_.cover [/.many] (and (|> (list\map code.nat expected+) - (/.run (/.many s.nat)) + (/.run (/.many <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))) (|> (list (code.nat expected0)) - (/.run (/.many s.nat)) + (/.run (/.many <code>.nat)) (match (list actual) (n.= expected0 actual))) (|> (list\map (|>> .int code.int) expected+) - (/.run (/.many s.nat)) + (/.run (/.many <code>.nat)) fails?))) (_.cover [/.filter] (and (|> (list (code.nat even0)) - (/.run (/.filter n.even? s.nat)) + (/.run (/.filter n.even? <code>.nat)) (match actual (n.= even0 actual))) (|> (list (code.nat odd0)) - (/.run (/.filter n.even? s.nat)) + (/.run (/.filter n.even? <code>.nat)) fails?))) (_.cover [/.and] - (let [even (/.filter n.even? s.nat) - odd (/.filter n.odd? s.nat)] + (let [even (/.filter n.even? <code>.nat) + odd (/.filter n.odd? <code>.nat)] (and (|> (list (code.nat even0) (code.nat odd0)) (/.run (/.and even odd)) (match [left right] @@ -143,8 +143,8 @@ (/.run (/.and even odd)) fails?)))) (_.cover [/.or] - (let [even (/.filter n.even? s.nat) - odd (/.filter n.odd? s.nat)] + (let [even (/.filter n.even? <code>.nat) + odd (/.filter n.odd? <code>.nat)] (and (|> (list (code.nat even0)) (/.run (/.or even odd)) (match (#.Left actual) (n.= even0 actual))) @@ -155,8 +155,8 @@ (/.run (/.or even odd)) fails?)))) (_.cover [/.either] - (let [even (/.filter n.even? s.nat) - odd (/.filter n.odd? s.nat)] + (let [even (/.filter n.even? <code>.nat) + odd (/.filter n.odd? <code>.nat)] (and (|> (list (code.nat even0)) (/.run (/.either even odd)) (match actual (n.= even0 actual))) @@ -168,10 +168,10 @@ fails?)))) (_.cover [/.not] (and (|> (list (code.nat expected0)) - (/.run (/.not s.nat)) + (/.run (/.not <code>.nat)) fails?) (|> (list (code.bit not0)) - (/.run (/.not s.nat)) + (/.run (/.not <code>.nat)) (match [] #1)))) ))) @@ -187,53 +187,53 @@ ($_ _.and (_.cover [/.exactly] (and (|> (list\map code.nat expected+) - (/.run (/.exactly times s.nat)) + (/.run (/.exactly times <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = (list.take times expected+) actual))) (|> (list\map code.nat expected+) - (/.run (/.exactly (inc variadic) s.nat)) + (/.run (/.exactly (inc variadic) <code>.nat)) fails?))) (_.cover [/.at_least] (and (|> (list\map code.nat expected+) - (/.run (/.at_least times s.nat)) + (/.run (/.at_least times <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))) (|> (list\map code.nat expected+) - (/.run (/.at_least (inc variadic) s.nat)) + (/.run (/.at_least (inc variadic) <code>.nat)) fails?))) (_.cover [/.at_most] (and (|> (list\map code.nat expected+) - (/.run (/.at_most times s.nat)) + (/.run (/.at_most times <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = (list.take times expected+) actual))) (|> (list\map code.nat expected+) - (/.run (/.at_most (inc variadic) s.nat)) + (/.run (/.at_most (inc variadic) <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))))) (_.cover [/.between] (and (|> (list\map code.nat expected+) - (/.run (/.between times variadic s.nat)) + (/.run (/.between times variadic <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))) (|> (list\map code.nat (list.take times expected+)) - (/.run (/.between times variadic s.nat)) + (/.run (/.between times variadic <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = (list.take times expected+) actual))))) - (_.cover [/.sep_by] + (_.cover [/.separated_by] (|> (list.interpose (code.text separator) (list\map code.nat expected+)) - (/.run (/.sep_by (s.this! (code.text separator)) s.nat)) + (/.run (/.separated_by (<code>.this! (code.text separator)) <code>.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ @@ -261,14 +261,14 @@ [expected random.nat even (random.filter n.even? random.nat) odd (random.filter n.odd? random.nat) - #let [nat^ s.nat - even^ (/.filter n.even? s.nat) - odd^ (/.filter n.odd? s.nat)]] + #let [nat^ <code>.nat + even^ (/.filter n.even? <code>.nat) + odd^ (/.filter n.odd? <code>.nat)]] ($_ _.and (_.cover [/.rec] (let [parser (/.rec (function (_ self) - (/.either s.nat - (s.tuple self)))) + (/.either <code>.nat + (<code>.tuple self)))) level_0 (code.nat expected) level_up (: (-> Code Code) (|>> list code.tuple))] @@ -282,17 +282,17 @@ (/.run parser) (match actual (n.= expected actual)))))) (_.cover [/.after] - (and (|> (/.run (/.after even^ s.nat) + (and (|> (/.run (/.after even^ <code>.nat) (list (code.nat even) (code.nat expected))) (match actual (n.= expected actual))) - (|> (/.run (/.after even^ s.nat) + (|> (/.run (/.after even^ <code>.nat) (list (code.nat odd) (code.nat expected))) fails?))) (_.cover [/.before] - (and (|> (/.run (/.before even^ s.nat) + (and (|> (/.run (/.before even^ <code>.nat) (list (code.nat expected) (code.nat even))) (match actual (n.= expected actual))) - (|> (/.run (/.before even^ s.nat) + (|> (/.run (/.before even^ <code>.nat) (list (code.nat expected) (code.nat odd))) fails?))) (_.cover [/.parses?] @@ -324,7 +324,7 @@ (and happy_path! sad_path!))) (_.cover [/.codec] - (|> (/.run (/.codec n.decimal s.text) + (|> (/.run (/.codec n.decimal <code>.text) (list (code.text (%.nat expected)))) (match actual (n.= expected actual)))) ))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 168f29f12..6e8c96118 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -40,7 +40,7 @@ #.None (list) (#.Some focus) (list focus)))))) -(def: (try computation) +(def: (attempt computation) (All [a] (-> (Meta a) (Meta (Try a)))) (function (_ compiler) (case (computation compiler) @@ -71,10 +71,10 @@ message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] (do meta.monad - [should_fail0 (..try (macro.expand (to_remember macro yesterday message #.None))) - should_fail1 (..try (macro.expand (to_remember macro yesterday message (#.Some expected)))) - should_succeed0 (..try (macro.expand (to_remember macro tomorrow message #.None))) - should_succeed1 (..try (macro.expand (to_remember macro tomorrow message (#.Some expected))))] + [should_fail0 (..attempt (macro.expand (to_remember macro yesterday message #.None))) + should_fail1 (..attempt (macro.expand (to_remember macro yesterday message (#.Some expected)))) + should_succeed0 (..attempt (macro.expand (to_remember macro tomorrow message #.None))) + should_succeed1 (..attempt (macro.expand (to_remember macro tomorrow message (#.Some expected))))] (wrap (list (code.bit (and (case should_fail0 (#try.Failure error) (and (test_failure yesterday message #.None error) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index b89246b26..6f1e22a7c 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -30,7 +30,7 @@ (function (_ ==) (\ (/.equivalence ==) =))) -(def: #export (try element) +(def: #export (attempt element) (All [a] (-> (Random a) (Random (Try a)))) ($_ random.or (random.unicode 1) @@ -47,7 +47,7 @@ #let [(^open "io\.") io.monad]]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..try random.nat))) + ($equivalence.spec (/.equivalence n.equivalence) (..attempt random.nat))) (_.for [/.functor] ($functor.spec ..injection ..comparison /.functor)) (_.for [/.apply] diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index ded33ed08..9835e52e4 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -64,13 +64,6 @@ (text\= "string" (/.type_of string)) (text\= "function" (/.type_of function)) (text\= "object" (/.type_of object)))) - (_.cover [/.try] - (case (/.try (error! string)) - (#try.Success _) - false - - (#try.Failure error) - (text\= string error))) (_.cover [/.import:] (let [encoding "utf8"] (text\= string diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index fe969cd3c..973216d84 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -1,7 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." ffi] [abstract [monad (#+ do)]] [control @@ -55,9 +54,9 @@ (:coerce (List Text) (io.run outcome))))) (with_expansions [<program> (/.program: [arg/0 arg/1 arg/2 arg/3] (io.io []))] - (case (ffi.try ((: (-> (List Text) (io.IO Any)) - (..actual_program <program>)) - inputs)) + (case (try ((: (-> (List Text) (io.IO Any)) + (..actual_program <program>)) + inputs)) (#try.Success _) false diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 6e22d611f..acdeaf653 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -124,7 +124,7 @@ loader (/loader.memory (/loader.new_library []))] _ (/loader.define class_name bytecode loader) class (io.run (/loader.load class_name loader)) - method (ffi.try (get_method method_name class))] + method (try (get_method method_name class))] (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) (#try.Success actual) (test actual) @@ -892,7 +892,7 @@ (case (do try.monad [_ (/loader.define class_name bytecode loader) class (io.run (/loader.load class_name loader)) - method (ffi.try (get_method static_method class)) + method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] (wrap (:coerce Int output))) (#try.Success actual) @@ -1357,7 +1357,7 @@ loader (/loader.memory (/loader.new_library []))] _ (/loader.define class_name bytecode loader) class (io.run (/loader.load class_name loader)) - method (ffi.try (get_method object_method_name class))] + method (try (get_method object_method_name class))] (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) (#try.Success actual) (test expected actual) @@ -1709,7 +1709,7 @@ _ (/loader.define interface_class interface_bytecode loader) _ (/loader.define concrete_class concrete_bytecode loader) class (io.run (/loader.load concrete_class loader)) - method (ffi.try (get_method static_method class)) + method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] (wrap (:coerce Int output))) (#try.Success actual) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux new file mode 100644 index 000000000..d321f88f5 --- /dev/null +++ b/stdlib/source/test/lux/test.lux @@ -0,0 +1,249 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io] + ["." exception] + [concurrency + ["." promise] + ["." atom (#+ Atom)]]] + [data + ["." text ("#\." equivalence)] + [collection + ["." list]]] + [math + ["." random] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: (verify expected_message/0 expected_message/1 successes failures [tally message]) + (-> Text Text Nat Nat [/.Tally Text] Bit) + (and (text.contains? expected_message/0 message) + (text.contains? expected_message/1 message) + (n.= successes (get@ #/.successes tally)) + (n.= failures (get@ #/.failures tally)))) + +(def: assertion + /.Test + (do {! random.monad} + [expected_message/0 (random.ascii/lower 5) + expected_message/1 (random.filter (|>> (text\= expected_message/0) not) + (random.ascii/lower 5))] + ($_ /.and + (wrap (do promise.monad + [[success_tally success_message] (/.assert expected_message/0 true) + [failure_tally failure_message] (/.assert expected_message/0 false)] + (/.cover' [/.assert /.Tally] + (and (text.ends_with? expected_message/0 success_message) + (text.ends_with? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally))))))) + (wrap (do promise.monad + [tt (/.and' (/.assert expected_message/0 true) + (/.assert expected_message/1 true)) + ff (/.and' (/.assert expected_message/0 false) + (/.assert expected_message/1 false)) + tf (/.and' (/.assert expected_message/0 true) + (/.assert expected_message/1 false)) + ft (/.and' (/.assert expected_message/0 false) + (/.assert expected_message/1 true))] + (/.cover' [/.and'] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft))))) + ))) + +(def: seed + /.Test + (do {! random.monad} + [seed random.nat + #let [[read write] (: [(promise.Promise Nat) (promise.Resolver Nat)] + (promise.promise []))] + pre (<| (/.seed seed) + (do ! + [sample random.nat + #let [wrote? (io.run (write sample))]] + (/.test "" wrote?))) + post (<| (/.seed seed) + (do ! + [actual random.nat] + (wrap (do promise.monad + [expected read] + (/.assert "" (n.= expected actual))))))] + (wrap (do promise.monad + [[pre_tally pre_message] pre + [post_tally post_message] post] + (/.cover' [/.seed] + (and (and (n.= 1 (get@ #/.successes pre_tally)) + (n.= 0 (get@ #/.failures pre_tally))) + (and (n.= 1 (get@ #/.successes post_tally)) + (n.= 0 (get@ #/.failures post_tally))))))))) + +(def: times + /.Test + ($_ /.and + (do {! random.monad} + [times_assertion (/.times 0 (/.test "" true))] + (wrap (do promise.monad + [[tally error] times_assertion] + (/.cover' [/.must_try_test_at_least_once] + (and (text.contains? (get@ #exception.label /.must_try_test_at_least_once) error) + (n.= 0 (get@ #/.successes tally)) + (n.= 1 (get@ #/.failures tally))))))) + (do {! random.monad} + [expected (\ ! map (|>> (n.% 10) inc) random.nat) + #let [counter (: (Atom Nat) + (atom.atom 0))] + times_assertion (<| (/.times expected) + (do ! + [_ (wrap []) + #let [_ (io.run (atom.update inc counter))]] + (/.test "" true)))] + (wrap (do promise.monad + [[tally error] times_assertion + actual (promise.future (atom.read counter))] + (/.cover' [/.times] + (and (n.= expected actual) + (n.= 1 (get@ #/.successes tally)) + (n.= 0 (get@ #/.failures tally))))))) + )) + +(def: in_parallel + /.Test + ($_ /.and + (do {! random.monad} + [expected (\ ! map (|>> (n.% 10) inc) random.nat) + #let [counter (: (Atom Nat) + (atom.atom 0))] + assertion (<| /.in_parallel + (list.repeat expected) + (: /.Test) + (do ! + [_ (wrap []) + #let [_ (io.run (atom.update inc counter))]] + (/.test "" true)))] + (wrap (do promise.monad + [[tally error] assertion + actual (promise.future (atom.read counter))] + (/.cover' [/.in_parallel] + (and (n.= expected actual) + (n.= expected (get@ #/.successes tally)) + (n.= 0 (get@ #/.failures tally))))))) + (do {! random.monad} + [expected (\ ! map (|>> (n.% 10) inc) random.nat) + #let [counter (: (Atom Nat) + (atom.atom 0))] + assertion (<| /.in_parallel + (list.repeat expected) + (: /.Test) + (do ! + [_ (wrap []) + #let [_ (undefined) + _ (io.run (atom.update inc counter))]] + (/.test "" true)))] + (wrap (do promise.monad + [[tally error] assertion + actual (promise.future (atom.read counter))] + (/.cover' [/.error_during_execution] + (let [correct_error! (text.contains? (get@ #exception.label /.error_during_execution) error) + no_complete_run! (n.= 0 actual) + no_successes! (n.= 0 (get@ #/.successes tally)) + ran_all_tests! (n.= expected (get@ #/.failures tally))] + (and correct_error! + no_complete_run! + no_successes! + ran_all_tests!)))))) + )) + +(def: #export test + /.Test + (<| (/.covering /._) + (/.for [/.Test]) + (do {! random.monad} + [expected_context (random.ascii/lower 5) + expected_message/0 (random.filter (|>> (text\= expected_context) not) + (random.ascii/lower 5)) + expected_message/1 (random.filter (|>> (text\= expected_message/0) not) + (random.ascii/lower 5))] + ($_ /.and + (/.for [/.Assertion] + ..assertion) + (/.for [/.Seed] + seed) + (do ! + [success_assertion (/.test expected_message/0 true) + failure_assertion (/.test expected_message/0 false)] + (wrap (do promise.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.test] + (and (text.ends_with? expected_message/0 success_message) + (text.ends_with? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) + (do ! + [tt (/.and (/.test expected_message/0 true) + (/.test expected_message/1 true)) + ff (/.and (/.test expected_message/0 false) + (/.test expected_message/1 false)) + tf (/.and (/.test expected_message/0 true) + (/.test expected_message/1 false)) + ft (/.and (/.test expected_message/0 false) + (/.test expected_message/1 true))] + (wrap (do promise.monad + [tt tt + ff ff + tf tf + ft ft] + (/.cover' [/.and] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft)))))) + (do ! + [success_assertion (/.context expected_context (/.test expected_message/0 true)) + failure_assertion (/.context expected_context (/.test expected_message/0 false))] + (wrap (do promise.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.context] + (and (and (text.contains? expected_context success_message) + (text.contains? expected_message/0 success_message)) + (and (text.contains? expected_context failure_message) + (text.contains? expected_message/0 failure_message)) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) + (do ! + [failure_assertion (/.fail expected_message/0)] + (wrap (do promise.monad + [[failure_tally failure_message] failure_assertion] + (/.cover' [/.fail] + (and (text.contains? expected_message/0 failure_message) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) + (do ! + [success_assertion (/.lift expected_message/0 (wrap true)) + failure_assertion (/.lift expected_message/0 (wrap false))] + (wrap (do promise.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.lift] + (and (text.contains? expected_message/0 success_message) + (text.contains? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) + ..times + ..in_parallel + )))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 316ef8783..551144a6b 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -1,7 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." ffi] [abstract [monad (#+ do)] {[0 #spec] @@ -12,7 +11,8 @@ ["$." codec]]}] [control ["." function] - ["." try]] + ["." try] + ["." io]] [data [collection ["." list ("#\." fold)]]] @@ -97,7 +97,7 @@ (apply duration.inverse day\pred 6) (apply duration.inverse day\pred 7))))) (_.cover [/.now] - (case (ffi.try /.now) + (case (try (io.run /.now)) (#try.Success _) true |