aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/ffi.jvm.lux20
-rw-r--r--stdlib/source/lux/math.lux39
-rw-r--r--stdlib/source/lux/math/number/complex.lux4
-rw-r--r--stdlib/source/lux/test.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux50
-rw-r--r--stdlib/source/lux/world/file.lux2
-rw-r--r--stdlib/source/lux/world/shell.lux3
-rw-r--r--stdlib/source/program/aedifex.lux4
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux16
-rw-r--r--stdlib/source/program/aedifex/command/build.lux128
-rw-r--r--stdlib/source/program/aedifex/command/test.lux6
-rw-r--r--stdlib/source/program/aedifex/format.lux2
-rw-r--r--stdlib/source/program/aedifex/parser.lux5
-rw-r--r--stdlib/source/program/aedifex/profile.lux12
-rw-r--r--stdlib/source/test/aedifex/command.lux9
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux29
-rw-r--r--stdlib/source/test/aedifex/command/build.lux12
-rw-r--r--stdlib/source/test/aedifex/command/test.lux10
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux457
-rw-r--r--stdlib/source/test/aedifex/input.lux17
-rw-r--r--stdlib/source/test/lux/math.lux182
23 files changed, 595 insertions, 432 deletions
diff --git a/stdlib/source/lux/ffi.jvm.lux b/stdlib/source/lux/ffi.jvm.lux
index 4e684acf5..69a9ea5a3 100644
--- a/stdlib/source/lux/ffi.jvm.lux
+++ b/stdlib/source/lux/ffi.jvm.lux
@@ -1358,8 +1358,8 @@
(syntax: #export (do_to obj {methods (<>.some partial_call^)})
{#.doc (doc "Call a variety of methods on an object. Then, return the object."
(do_to object
- (ClassName::method1 arg0 arg1 arg2)
- (ClassName::method2 arg3 arg4 arg5)))}
+ (ClassName::method1 arg0 arg1 arg2)
+ (ClassName::method2 arg3 arg4 arg5)))}
(with_gensyms [g!obj]
(wrap (list (` (let [(~ g!obj) (~ obj)]
(exec (~+ (list\map (complete_call$ g!obj) methods))
@@ -2023,3 +2023,19 @@
(syntax: #export (type {type (..type^ (list))})
(wrap (list (value_type #ManualPrM type))))
+
+(exception: #export (cannot_cast_to_non_object {type (Type Value)})
+ (exception.report
+ ["Signature" (..signature type)]
+ ["Reflection" (..reflection type)]))
+
+(syntax: #export (:as {type (..type^ (list))}
+ object)
+ (case [(parser.array? type)
+ (parser.class? type)]
+ (^or [(#.Some _) _] [_ (#.Some _)])
+ (wrap (list (` (.: (~ (..value_type #ManualPrM type))
+ ("jvm object cast" (~ object))))))
+
+ _
+ (meta.fail (exception.construct ..cannot_cast_to_non_object [type]))))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 1928d7c9a..e8f1433c1 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -292,31 +292,32 @@
## else
floored)))
-(def: #export (atan2 param subject)
+(def: #export (atan/2 x y)
(-> Frac Frac Frac)
- (cond ("lux f64 <" param +0.0)
- (..atan ("lux f64 /" param subject))
+ (cond ("lux f64 <" x +0.0)
+ (..atan ("lux f64 /" x y))
- ("lux f64 <" +0.0 param)
- (if (or ("lux f64 <" subject +0.0)
- ("lux f64 =" +0.0 subject))
- (|> subject ("lux f64 /" param) atan ("lux f64 +" pi))
- (|> subject ("lux f64 /" param) atan ("lux f64 -" pi)))
+ ("lux f64 <" +0.0 x)
+ (if (or ("lux f64 <" y +0.0)
+ ("lux f64 =" +0.0 y))
+ (|> y ("lux f64 /" x) atan ("lux f64 +" pi))
+ (|> y ("lux f64 /" x) atan ("lux f64 -" pi)))
- ## ("lux f64 =" +0.0 param)
- (cond ("lux f64 <" subject +0.0)
+ ## ("lux f64 =" +0.0 x)
+ (cond ("lux f64 <" y +0.0)
(|> pi ("lux f64 /" +2.0))
- ("lux f64 <" +0.0 subject)
+ ("lux f64 <" +0.0 y)
(|> pi ("lux f64 /" -2.0))
- ## ("lux f64 =" +0.0 subject)
+ ## ("lux f64 =" +0.0 y)
("lux f64 /" +0.0 +0.0))))
(def: #export (log' base input)
(-> Frac Frac Frac)
- ("lux f64 /" (log base)
- (log input)))
+ ("lux f64 /"
+ (..log base)
+ (..log input)))
(def: #export (factorial n)
(-> Nat Nat)
@@ -328,20 +329,20 @@
(def: #export (hypotenuse catA catB)
(-> Frac Frac Frac)
- (pow +0.5 ("lux f64 +"
- (pow +2.0 catA)
- (pow +2.0 catB))))
+ (..pow +0.5 ("lux f64 +"
+ (..pow +2.0 catA)
+ (..pow +2.0 catB))))
## Hyperbolic functions
## https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions
(template [<name> <comp> <inverse>]
[(def: #export (<name> x)
(-> Frac Frac)
- (|> (exp x) (<comp> (exp ("lux f64 *" -1.0 x))) ("lux f64 /" +2.0)))
+ (|> (..exp x) (<comp> (..exp ("lux f64 *" -1.0 x))) ("lux f64 /" +2.0)))
(def: #export (<inverse> x)
(-> Frac Frac)
- (|> +2.0 ("lux f64 /" (|> (exp x) (<comp> (exp ("lux f64 *" -1.0 x)))))))]
+ (|> +2.0 ("lux f64 /" (|> (..exp x) (<comp> (..exp ("lux f64 *" -1.0 x)))))))]
[sinh "lux f64 -" csch]
[cosh "lux f64 +" sech]
diff --git a/stdlib/source/lux/math/number/complex.lux b/stdlib/source/lux/math/number/complex.lux
index 3da5071b0..aad6a4364 100644
--- a/stdlib/source/lux/math/number/complex.lux
+++ b/stdlib/source/lux/math/number/complex.lux
@@ -212,7 +212,7 @@
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
{#real (|> subject ..abs math.log)
- #imaginary (math.atan2 real imaginary)}))
+ #imaginary (math.atan/2 real imaginary)}))
(template [<name> <type> <op>]
[(def: #export (<name> param input)
@@ -283,7 +283,7 @@
(def: #export (argument (^slots [#real #imaginary]))
(-> Complex Frac)
- (math.atan2 real imaginary))
+ (math.atan/2 real imaginary))
(def: #export (roots nth input)
(-> Nat Complex (List Complex))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 513765864..bd7927a15 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -188,6 +188,13 @@
("lux io log" "Time-out reached! Retrying tests...")
(product.right (recur prng)))))])))))
+## TODO: Figure out why tests sometimes freeze and fix it. Delete "seed'" afterwards.
+(def: #export (seed' millis_time_out value test)
+ (-> (Maybe Nat) Seed Test Test)
+ (<| (..times' millis_time_out 1)
+ (..seed value)
+ test))
+
(def: #export times
(-> Nat Test Test)
(..times' #.None))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index d505f5f7c..d43259443 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -340,7 +340,7 @@
<Signal> (as_is (Resolver <Result>))
<Pending> (as_is [<Return> <Signal>])
<Importer> (as_is (-> Module Module <Return>))
- <Compiler> (as_is (-> <Importer> archive.ID <Context> Module <Return>))]
+ <Compiler> (as_is (-> Module <Importer> archive.ID <Context> Module <Return>))]
(def: (parallel initial)
(All [<type_vars>]
(-> <Context>
@@ -420,7 +420,7 @@
(#.Some [context module_id resolver])
(do !
- [result (compile import! module_id context module)
+ [result (compile importer import! module_id context module)
result (case result
(#try.Failure error)
(wrap result)
@@ -487,10 +487,11 @@
((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list))))
compiler (..parallel
context
- (function (_ import! module_id [archive state] module)
+ (function (_ importer import! module_id [archive state] module)
(do {! (try.with promise.monad)}
[#let [state (..set_current_module module state)]
input (context.read (get@ #&file_system platform)
+ importer
import
compilation_sources
(get@ #static.host_module_extension static)
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 7fe4b96a9..e611f9f47 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -384,6 +384,10 @@
(..initial_purge caches)
load_order))
+(def: pseudo_module
+ Text
+ "(Lux Caching System)")
+
(def: (load_every_reserved_module host_environment system static import contexts archive)
(All [expression directive]
(-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive
@@ -399,7 +403,7 @@
(wrap [true
[module_name [module_id [descriptor document (: Output row.empty)]]]])
(do !
- [input (//context.read system import contexts (get@ #static.host_module_extension static) module_name)]
+ [input (//context.read system ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)]
(wrap [(..valid_cache? descriptor input)
[module_name [module_id [descriptor document (: Output row.empty)]]]])))))))
load_order (|> pre_loaded_caches
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 3bb388f5e..33f201571 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -30,14 +30,14 @@
[descriptor (#+ Module)]]
["/#" // (#+ Input)]]])
-(template [<name>]
- [(exception: #export (<name> {module Module})
- (exception.report
- ["Module" (%.text module)]))]
+(exception: #export (cannot_find_module {importer Module} {module Module})
+ (exception.report
+ ["Module" (%.text module)]
+ ["Importer" (%.text importer)]))
- [cannot_find_module]
- [cannot_read_module]
- )
+(exception: #export (cannot_read_module {module Module})
+ (exception.report
+ ["Module" (%.text module)]))
(type: #export Extension
Text)
@@ -52,12 +52,12 @@
(//.sanitize system)
(format context (\ system separator))))
-(def: (find_source_file system contexts module extension)
- (-> (file.System Promise) (List Context) Module Extension
+(def: (find_source_file system importer contexts module extension)
+ (-> (file.System Promise) Module (List Context) Module Extension
(Promise (Try [Path (File Promise)])))
(case contexts
#.Nil
- (promise\wrap (exception.throw ..cannot_find_module [module]))
+ (promise\wrap (exception.throw ..cannot_find_module [importer module]))
(#.Cons context contexts')
(do promise.monad
@@ -68,19 +68,19 @@
(wrap (#try.Success [path file]))
(#try.Failure _)
- (find_source_file system contexts' module extension)))))
+ (find_source_file system importer contexts' module extension)))))
(def: (full_host_extension partial_host_extension)
(-> Extension Extension)
(format partial_host_extension ..lux_extension))
-(def: (find_local_source_file system import contexts partial_host_extension module)
- (-> (file.System Promise) Import (List Context) Extension Module
+(def: (find_local_source_file system importer import contexts partial_host_extension module)
+ (-> (file.System Promise) Module Import (List Context) Extension Module
(Promise (Try [Path Binary])))
## Preference is explicitly being given to Lux files that have a host extension.
## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
(do {! promise.monad}
- [outcome (..find_source_file system contexts module (..full_host_extension partial_host_extension))]
+ [outcome (..find_source_file system importer contexts module (..full_host_extension partial_host_extension))]
(case outcome
(#try.Success [path file])
(do (try.with !)
@@ -89,12 +89,12 @@
(#try.Failure _)
(do (try.with !)
- [[path file] (..find_source_file system contexts module ..lux_extension)
+ [[path file] (..find_source_file system importer contexts module ..lux_extension)
data (!.use (\ file content) [])]
(wrap [path data])))))
-(def: (find_library_source_file import partial_host_extension module)
- (-> Import Extension Module (Try [Path Binary]))
+(def: (find_library_source_file importer import partial_host_extension module)
+ (-> Module Import Extension Module (Try [Path Binary]))
(let [path (format module (..full_host_extension partial_host_extension))]
(case (dictionary.get path import)
(#.Some data)
@@ -107,27 +107,27 @@
(#try.Success [path data])
#.None
- (exception.throw ..cannot_find_module [module]))))))
+ (exception.throw ..cannot_find_module [importer module]))))))
-(def: (find_any_source_file system import contexts partial_host_extension module)
- (-> (file.System Promise) Import (List Context) Extension Module
+(def: (find_any_source_file system importer import contexts partial_host_extension module)
+ (-> (file.System Promise) Module Import (List Context) Extension Module
(Promise (Try [Path Binary])))
## Preference is explicitly being given to Lux files that have a host extension.
## Normal Lux files (i.e. without a host extension) are then picked as fallback files.
(do {! promise.monad}
- [outcome (find_local_source_file system import contexts partial_host_extension module)]
+ [outcome (find_local_source_file system importer import contexts partial_host_extension module)]
(case outcome
(#try.Success [path data])
(wrap outcome)
(#try.Failure _)
- (wrap (..find_library_source_file import partial_host_extension module)))))
+ (wrap (..find_library_source_file importer import partial_host_extension module)))))
-(def: #export (read system import contexts partial_host_extension module)
- (-> (file.System Promise) Import (List Context) Extension Module
+(def: #export (read system importer import contexts partial_host_extension module)
+ (-> (file.System Promise) Module Import (List Context) Extension Module
(Promise (Try Input)))
(do (try.with promise.monad)
- [[path binary] (..find_any_source_file system import contexts partial_host_extension module)]
+ [[path binary] (..find_any_source_file system importer import contexts partial_host_extension module)]
(case (\ utf8.codec decode binary)
(#try.Success code)
(wrap {#////.module module
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 0cb7136c4..670c1df6f 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*
- ["." ffi]
["@" target]
+ ["." ffi]
[abstract
["." monad (#+ Monad do)]]
[control
diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux
index 77da2c9d8..b1556d35c 100644
--- a/stdlib/source/lux/world/shell.lux
+++ b/stdlib/source/lux/world/shell.lux
@@ -277,8 +277,7 @@
(def: write
(..can_write
(function (_ message)
- (|> jvm_output
- (java/io/OutputStream::write (\ utf8.codec encode message))))))
+ (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output))))
(~~ (template [<name> <capability> <method>]
[(def: <name>
(<capability>
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 4b812bef4..2d873f8a8 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -190,8 +190,8 @@
(#try.Success watcher)
(..command
(case auto
- #/cli.Build (..with_dependencies program console (/command/auto.do! watcher /command/build.do!) profile)
- #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile)))))
+ #/cli.Build (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/build.do!) profile)
+ #/cli.Test (..with_dependencies program console (/command/auto.do! /command/auto.delay watcher /command/test.do!) profile)))))
_
(undefined)))
diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux
index afce4d6ff..000384ccd 100644
--- a/stdlib/source/program/aedifex/command/auto.lux
+++ b/stdlib/source/program/aedifex/command/auto.lux
@@ -42,13 +42,17 @@
(#try.Failure error)
(wrap (list)))))
-(def: (pause _)
- (-> Any (Promise (Try Any)))
- (promise.delay 1,000 (#try.Success [])))
+(def: #export delay
+ Nat
+ 1,000)
-(def: #export (do! watcher command)
+(def: (pause delay)
+ (-> Nat (Promise (Try Any)))
+ (promise.delay delay (#try.Success [])))
+
+(def: #export (do! delay watcher command)
(All [a]
- (-> (Watcher Promise)
+ (-> Nat (Watcher Promise)
(-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a))
(-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))))
(function (_ console program fs shell resolution)
@@ -65,7 +69,7 @@
_ <call>]
(loop [_ []]
(do !
- [_ (..pause [])
+ [_ (..pause delay)
events (\ watcher poll [])
_ (case events
(#.Cons _)
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 7052109fb..e2d6f78b8 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -132,66 +132,82 @@
(def: #export failure "[BUILD FAILED]")
(template [<name> <capability>]
- [(def: (<name> console process)
+ [(def: #export (<name> console process)
(-> (Console Promise) (Process Promise) (Promise (Try Any)))
- (do {! promise.monad}
- [?line (!.use (\ process <capability>) [])]
- (case ?line
- (#try.Failure error)
- (if (exception.match? shell.no_more_output error)
- (wrap (#try.Success []))
- (console.write_line error console))
-
- (#try.Success line)
- (do (try.with !)
- [_ (console.write_line line console)]
- (log_output! console process)))))]
+ ## This is a very odd way of implementing this function.
+ ## But it's written this way because the more straightforward way (i.e. by using (try.with promise.monad))
+ ## eventually led to the function hanging/freezing.
+ ## I'm not sure why it happened, but I got this weirder implementation to work.
+ (let [[read! write!] (: [(Promise (Try Any))
+ (promise.Resolver (Try Any))]
+ (promise.promise []))
+ _ (|> (!.use (\ process <capability>) [])
+ (promise.await (function (recur ?line)
+ (case ?line
+ (#try.Failure error)
+ (if (exception.match? shell.no_more_output error)
+ (write! (#try.Success []))
+ (promise.await write! (console.write_line error console)))
+
+ (#try.Success line)
+ (promise.await (function (_ outcome)
+ (case outcome
+ (#try.Failure error)
+ (write! (#try.Failure error))
+
+ (#try.Success _)
+ (promise.await recur
+ (!.use (\ process <capability>) []))))
+ (console.write_line line console)))))
+ io.run)]
+ read!))]
[log_output! read]
[log_error! error]
)
-(def: #export (do! console program fs shell resolution profile)
+(def: #export (do! console program fs shell resolution)
(-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path]))
- (case [(get@ #///.program profile)
- (get@ #///.target profile)]
- [#.None _]
- (promise\wrap (exception.throw ..no_specified_program []))
-
- [_ #.None]
- (promise\wrap (exception.throw ..no_specified_target []))
-
- [(#.Some program_module) (#.Some target)]
- (do promise.monad
- [environment (\ program environment [])
- home (\ program home [])
- working_directory (\ program directory [])]
- (do ///action.monad
- [[resolution compiler] (promise\wrap (..compiler resolution))
- #let [[[command compiler_params] output] (case compiler
- (#JVM dependency) [(///runtime.java (..path fs home dependency))
- "program.jar"]
- (#JS dependency) [(///runtime.node (..path fs home dependency))
- "program.js"])
- / (\ fs separator)
- cache_directory (format working_directory / target)]
- _ (console.write_line ..start console)
- process (!.use (\ shell execute)
- [environment
- working_directory
- command
- (list.concat (list compiler_params
- (list "build")
- (..plural "--library" (..libraries fs home resolution))
- (..plural "--source" (set.to_list (get@ #///.sources profile)))
- (..singular "--target" cache_directory)
- (..singular "--module" program_module)))])
- _ (..log_output! console process)
- _ (..log_error! console process)
- exit (!.use (\ process await) [])
- _ (console.write_line (if (i.= shell.normal exit)
- ..success
- ..failure)
- console)]
- (wrap [compiler
- (format cache_directory / output)])))))
+ (function (_ profile)
+ (case [(get@ #///.program profile)
+ (get@ #///.target profile)]
+ [#.None _]
+ (promise\wrap (exception.throw ..no_specified_program []))
+
+ [_ #.None]
+ (promise\wrap (exception.throw ..no_specified_target []))
+
+ [(#.Some program_module) (#.Some target)]
+ (do promise.monad
+ [environment (\ program environment [])
+ home (\ program home [])
+ working_directory (\ program directory [])]
+ (do ///action.monad
+ [[resolution compiler] (promise\wrap (..compiler resolution))
+ #let [[[command compiler_params] output] (case compiler
+ (#JVM dependency) [(///runtime.java (..path fs home dependency))
+ "program.jar"]
+ (#JS dependency) [(///runtime.node (..path fs home dependency))
+ "program.js"])
+ / (\ fs separator)
+ cache_directory (format working_directory / target)]
+ _ (console.write_line ..start console)
+ process (!.use (\ shell execute)
+ [environment
+ working_directory
+ command
+ (list.concat (list compiler_params
+ (list "build")
+ (..plural "--library" (..libraries fs home resolution))
+ (..plural "--source" (set.to_list (get@ #///.sources profile)))
+ (..singular "--target" cache_directory)
+ (..singular "--module" program_module)))])
+ _ (..log_output! console process)
+ _ (..log_error! console process)
+ exit (!.use (\ process await) [])
+ _ (console.write_line (if (i.= shell.normal exit)
+ ..success
+ ..failure)
+ console)]
+ (wrap [compiler
+ (format cache_directory / output)]))))))
diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux
index c3b517437..e717b7cd6 100644
--- a/stdlib/source/program/aedifex/command/test.lux
+++ b/stdlib/source/program/aedifex/command/test.lux
@@ -21,6 +21,7 @@
["." // #_
["#." build]
["/#" // #_
+ ["#" profile]
["#." action]
["#." command (#+ Command)]
["#." runtime]
@@ -37,7 +38,8 @@
[environment (\ program environment [])
working_directory (\ program directory [])]
(do ///action.monad
- [[compiler program] (//build.do! console program fs shell resolution profile)
+ [[compiler program] (//build.do! console program fs shell resolution
+ (set@ #///.program (get@ #///.test profile) profile))
_ (console.write_line ..start console)
#let [[compiler_command compiler_parameters] (case compiler
(#//build.JVM artifact) (///runtime.java program)
@@ -47,6 +49,8 @@
working_directory
compiler_command
compiler_parameters])
+ _ (//build.log_output! console process)
+ _ (//build.log_error! console process)
exit (!.use (\ process await) [])
_ (console.write_line (if (i.= shell.normal exit)
..success
diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux
index d42333fd9..6fcbb2db7 100644
--- a/stdlib/source/program/aedifex/format.lux
+++ b/stdlib/source/program/aedifex/format.lux
@@ -143,7 +143,7 @@
(..on_maybe "target" (get@ #/.target value) code.text)
(..on_maybe "program" (get@ #/.program value) code.text)
(..on_maybe "test" (get@ #/.test value) code.text)
- (..on_dictionary "deploy-repositories" (get@ #/.deploy_repositories value) code.text code.text)
+ (..on_dictionary "deploy_repositories" (get@ #/.deploy_repositories value) code.text code.text)
..aggregate))
(def: #export project
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 046c8893c..3c1b4144a 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -171,9 +171,6 @@
(<>.and <c>.text
..repository))))
-(def: default_repository
- "https://repo1.maven.org/maven2/")
-
(def: profile
(Parser /.Profile)
(do {! <>.monad}
@@ -194,7 +191,7 @@
(|> (..plural input "repositories" ..repository)
(\ ! map (set.from_list text.hash))
(<>.default (set.new text.hash))
- (\ ! map (set.add ..default_repository))))
+ (\ ! map (set.add /.default_repository))))
^dependencies (: (Parser (Set //dependency.Dependency))
(|> (..plural input "dependencies" ..dependency)
(\ ! map (set.from_list //dependency.hash))
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index fa49e41cd..592e221fd 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -24,8 +24,8 @@
[//
["." artifact (#+ Artifact)]
["." dependency]
- ["." repository #_
- ["#" remote (#+ Address)]]])
+ [repository
+ [remote (#+ Address)]]])
(type: #export Distribution
#Repo
@@ -132,6 +132,10 @@
Target
"target")
+(def: #export default_repository
+ Address
+ "https://repo1.maven.org/maven2/")
+
(type: #export Name
Text)
@@ -143,13 +147,13 @@
{#parents (List Name)
#identity (Maybe Artifact)
#info (Maybe Info)
- #repositories (Set repository.Address)
+ #repositories (Set Address)
#dependencies (Set dependency.Dependency)
#sources (Set Source)
#target (Maybe Target)
#program (Maybe Module)
#test (Maybe Module)
- #deploy_repositories (Dictionary Text repository.Address)})
+ #deploy_repositories (Dictionary Text Address)})
(def: #export equivalence
(Equivalence Profile)
diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux
index e0cb2da79..42d1c1278 100644
--- a/stdlib/source/test/aedifex/command.lux
+++ b/stdlib/source/test/aedifex/command.lux
@@ -12,11 +12,10 @@
["#." deploy]
["#." build]
- ["#." test]]
+ ["#." test]
+ ["#." auto]]
{#program
- ["." /
- ## ["#." auto]
- ]})
+ ["." /]})
(def: #export test
Test
@@ -34,5 +33,5 @@
/build.test
/test.test
- ## /auto.test
+ /auto.test
)))
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux
index 7bac6eb5d..c23519bcc 100644
--- a/stdlib/source/test/aedifex/command/auto.lux
+++ b/stdlib/source/test/aedifex/command/auto.lux
@@ -20,7 +20,7 @@
["." set]
["." list ("#\." functor)]]]
[math
- ["." random]
+ ["." random (#+ Random)]
[number
["n" nat]]]
[world
@@ -56,10 +56,10 @@
[@runs
(function (_ console program fs shell resolution profile)
(do {! promise.monad}
- [[runs remaining_files] (promise.future
- (atom.update (function (_ [runs remaining_files])
- [(inc runs) remaining_files])
- @runs))]
+ [[_ [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))
@@ -78,15 +78,10 @@
[#let [/ (\ file.default separator)
[fs watcher] (watch.mock /)]
end_signal (random.ascii/alpha 5)
+
program (random.ascii/alpha 5)
target (random.ascii/alpha 5)
- home (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)
@@ -98,6 +93,14 @@
with_program
with_target
(set@ #///.sources (set.from_list text.hash (list source))))]
+
+ home (random.ascii/alpha 5)
+ working_directory (random.ascii/alpha 5)
+
+ expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat)
+ dummy_files (|> (random.ascii/alpha 5)
+ (random.set text.hash (dec expected_runs))
+ (\ ! map (|>> set.to_list (list\map (|>> (format source /))))))
resolution @build.resolution]
($_ _.and
(wrap (do promise.monad
@@ -106,11 +109,11 @@
_ (!.use (\ fs create_directory) [source])
_ (\ watcher poll [])]
(do promise.monad
- [outcome ((/.do! watcher command)
+ [outcome ((/.do! 1 watcher command)
(@version.echo "")
(program.async (program.mock environment.empty home working_directory))
fs
- (@build.good_shell [])
+ (shell.async (@build.good_shell []))
resolution
profile)
[actual_runs _] (promise.future (atom.read @runs))]
diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux
index 85231ae33..234343fea 100644
--- a/stdlib/source/test/aedifex/command/build.lux
+++ b/stdlib/source/test/aedifex/command/build.lux
@@ -45,9 +45,9 @@
(: (shell.Simulation [])
(structure
(def: (on_read state)
- (#try.Failure "on_read"))
+ (exception.throw shell.no_more_output []))
(def: (on_error state)
- (#try.Failure "on_error"))
+ (exception.throw shell.no_more_output []))
(def: (on_write input state)
(#try.Failure "on_write"))
(def: (on_destroy state)
@@ -63,9 +63,9 @@
(: (shell.Simulation [])
(structure
(def: (on_read state)
- (#try.Failure "on_read"))
+ (exception.throw shell.no_more_output []))
(def: (on_error state)
- (#try.Failure "on_error"))
+ (exception.throw shell.no_more_output []))
(def: (on_write input state)
(#try.Failure "on_write"))
(def: (on_destroy state)
@@ -98,7 +98,9 @@
Test
(<| (_.covering /._)
(do {! random.monad}
- [#let [fs (file.mock (\ file.default separator))
+ [last_read (random.ascii/alpha 5)
+ last_error (random.ascii/alpha 5)
+ #let [fs (file.mock (\ file.default separator))
shell (shell.async (..good_shell []))]
program (random.ascii/alpha 5)
target (random.ascii/alpha 5)
diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux
index 9dd76ca08..36c21b520 100644
--- a/stdlib/source/test/aedifex/command/test.lux
+++ b/stdlib/source/test/aedifex/command/test.lux
@@ -5,6 +5,7 @@
[monad (#+ do)]]
[control
["." try]
+ ["." exception]
[concurrency
["." promise]]
[parser
@@ -14,7 +15,8 @@
[data
["." text ("#\." equivalence)]
[collection
- ["." dictionary]]]
+ ["." dictionary]
+ ["." list]]]
[math
["." random]]
[world
@@ -84,15 +86,15 @@
(: (shell.Simulation [])
(structure
(def: (on_read state)
- (#try.Failure "on_read"))
+ (exception.throw shell.no_more_output []))
(def: (on_error state)
- (#try.Failure "on_error"))
+ (exception.throw shell.no_more_output []))
(def: (on_write input state)
(#try.Failure "on_write"))
(def: (on_destroy state)
(#try.Failure "on_destroy"))
(def: (on_await state)
- (#try.Success [state (if (text.ends_with? " build" actual_command)
+ (#try.Success [state (if (list.any? (text\= "build") actual_arguments)
shell.normal
shell.error)]))))))
[])]
diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux
index e9cd26a82..ae8c7699b 100644
--- a/stdlib/source/test/aedifex/dependency/resolution.lux
+++ b/stdlib/source/test/aedifex/dependency/resolution.lux
@@ -13,33 +13,31 @@
[concurrency
["." promise]]]
[data
+ [binary (#+ Binary)]
["." product]
- ["." binary]
["." text
+ ["%" format (#+ format)]
[encoding
["." utf8]]]
[format
["." xml]]
[collection
["." dictionary]
- ["." set]]]
+ ["." set]
+ ["." list]]]
[math
["." random (#+ Random)]]]
["$." /// #_
["#." package]
["#." repository]
- ["#." artifact]
- [//
- [lux
- [data
- ["$." binary]]]]]
+ ["#." artifact]]
{#program
["." /
["//#" /// #_
["#" profile]
["#." package (#+ Package)]
["#." hash]
- ["#." dependency
+ ["#." dependency (#+ Dependency) ("#\." equivalence)
["#/." status]]
["#." pom]
["#." artifact (#+ Artifact)
@@ -94,6 +92,136 @@
(def: (on_upload uri binary state)
(#try.Failure "NOPE")))))
+(def: lux_sha1
+ Text
+ (format ///artifact/extension.lux_library ///artifact/extension.sha-1))
+
+(def: lux_md5
+ Text
+ (format ///artifact/extension.lux_library ///artifact/extension.md5))
+
+(def: pom_sha1
+ Text
+ (format ///artifact/extension.pom ///artifact/extension.sha-1))
+
+(def: pom_md5
+ Text
+ (format ///artifact/extension.pom ///artifact/extension.md5))
+
+(def: sha1
+ (-> Binary Binary)
+ (|>> ///hash.sha-1
+ (\ ///hash.sha-1_codec encode)
+ (\ utf8.codec encode)))
+
+(def: md5
+ (-> Binary Binary)
+ (|>> ///hash.md5
+ (\ ///hash.md5_codec encode)
+ (\ utf8.codec encode)))
+
+(def: (bad_sha-1 expected_artifact expected_package dummy_package)
+ (-> Artifact Package Package (Simulation Any))
+ (structure
+ (def: (on_download uri state)
+ (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
+ (cond (text.ends_with? ///artifact/extension.lux_library uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.library)
+ product.left)])
+
+ (text.ends_with? lux_sha1 uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.library)
+ product.left
+ sha1)])
+
+ (text.ends_with? lux_md5 uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.library)
+ product.left
+ md5)])
+
+ (text.ends_with? ///artifact/extension.pom uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode))])
+
+ (text.ends_with? pom_sha1 uri)
+ (#try.Success [state (|> dummy_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode)
+ sha1)])
+
+ (text.ends_with? pom_md5 uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode)
+ md5)])
+
+ ## else
+ (#try.Failure "NOPE"))
+ (#try.Failure "NOPE")))
+ (def: (on_upload uri binary state)
+ (#try.Failure "NOPE"))))
+
+(def: (bad_md5 expected_artifact expected_package dummy_package)
+ (-> Artifact Package Package (Simulation Any))
+ (structure
+ (def: (on_download uri state)
+ (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
+ (cond (text.ends_with? ///artifact/extension.lux_library uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.library)
+ product.left)])
+
+ (text.ends_with? lux_sha1 uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.library)
+ product.left
+ sha1)])
+
+ (text.ends_with? lux_md5 uri)
+ (#try.Success [state (|> dummy_package
+ (get@ #///package.library)
+ product.left
+ md5)])
+
+ (text.ends_with? ///artifact/extension.pom uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode))])
+
+ (text.ends_with? pom_sha1 uri)
+ (#try.Success [state (|> expected_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode)
+ sha1)])
+
+ (text.ends_with? pom_md5 uri)
+ (#try.Success [state (|> dummy_package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode)
+ md5)])
+
+ ## else
+ (#try.Failure "NOPE"))
+ (#try.Failure "NOPE")))
+ (def: (on_upload uri binary state)
+ (#try.Failure "NOPE"))))
+
(def: one
Test
(do {! random.monad}
@@ -105,72 +233,8 @@
not)
$///package.random)
#let [good (..single expected_artifact expected_package)
- bad_sha-1 (: (Simulation Any)
- (structure
- (def: (on_download uri state)
- (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.sha-1)
- ## (#try.Success [state (|> dummy_package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.md5)
- ## (#try.Success [state (|> expected_package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ utf8.codec encode))])
-
- ## else
- (#try.Failure "NOPE"))
- (#try.Failure "NOPE")))
- (def: (on_upload uri binary state)
- (#try.Failure "NOPE"))))
- bad_md5 (: (Simulation Any)
- (structure
- (def: (on_download uri state)
- (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.sha-1)
- ## (#try.Success [state (|> expected_package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.md5)
- ## (#try.Success [state (|> dummy_package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ utf8.codec encode))])
-
- ## else
- (#try.Failure "NOPE"))
- (#try.Failure "NOPE")))
- (def: (on_upload uri binary state)
- (#try.Failure "NOPE"))))]]
+ bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package)
+ bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]]
(`` ($_ _.and
(wrap
(do promise.monad
@@ -216,72 +280,8 @@
not)
$///package.random)
#let [good (..single expected_artifact expected_package)
- bad_sha-1 (: (Simulation Any)
- (structure
- (def: (on_download uri state)
- (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.sha-1)
- ## (#try.Success [state (|> dummy_package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.md5)
- ## (#try.Success [state (|> expected_package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ utf8.codec encode))])
-
- ## else
- (#try.Failure "NOPE"))
- (#try.Failure "NOPE")))
- (def: (on_upload uri binary state)
- (#try.Failure "NOPE"))))
- bad_md5 (: (Simulation Any)
- (structure
- (def: (on_download uri state)
- (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> expected_package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.sha-1)
- ## (#try.Success [state (|> expected_package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ utf8.codec encode))])
-
- ## (text\= extension ///artifact/extension.md5)
- ## (#try.Success [state (|> dummy_package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ utf8.codec encode))])
-
- ## else
- (#try.Failure "NOPE"))
- (#try.Failure "NOPE")))
- (def: (on_upload uri binary state)
- (#try.Failure "NOPE"))))]]
+ bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package)
+ bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]]
($_ _.and
(wrap
(do promise.monad
@@ -314,77 +314,106 @@
false))))
)))
-## (def: all
-## Test
-## (do {! random.monad}
-## [dependee_artifact $///artifact.random
-## depender_artifact (random.filter (predicate.complement
-## (\ ///artifact.equivalence = dependee_artifact))
-## $///artifact.random)
-## ignored_artifact (random.filter (predicate.complement
-## (predicate.unite (\ ///artifact.equivalence = dependee_artifact)
-## (\ ///artifact.equivalence = depender_artifact)))
-## $///artifact.random)
-
-## [_ dependee_package] $///package.random
-## [_ depender_package] $///package.random
-## [_ ignored_package] $///package.random
-
-## #let [dependee {#///dependency.artifact dependee_artifact
-## #///dependency.type ///artifact/type.lux_library}
-## depender {#///dependency.artifact depender_artifact
-## #///dependency.type ///artifact/type.lux_library}
-## ignored {#///dependency.artifact ignored_artifact
-## #///dependency.type ///artifact/type.lux_library}
-
-## dependee_pom (|> (\ ///.monoid identity)
-## (set@ #///.identity (#.Some dependee_artifact))
-## ///pom.write
-## try.assume)
-## depender_pom (|> (\ ///.monoid identity)
-## (set@ #///.identity (#.Some depender_artifact))
-## (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee)))
-## ///pom.write
-## try.assume)
-## ignored_pom (|> (\ ///.monoid identity)
-## (set@ #///.identity (#.Some ignored_artifact))
-## ///pom.write
-## try.assume)
-
-## dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package)
-## depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package)
-## ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]]
-## ($_ _.and
-## (wrap
-## (do promise.monad
-## [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) [])
-## (///repository.mock (..single depender_artifact depender_package) [])
-## (///repository.mock (..single ignored_artifact ignored_package) []))
-## (list depender)
-## /.empty)]
-## (_.cover' [/.all]
-## (case resolution
-## (#try.Success resolution)
-## (and (dictionary.key? resolution depender)
-## (dictionary.key? resolution dependee)
-## (not (dictionary.key? resolution ignored)))
-
-## (#try.Failure error)
-## false))))
-## )))
-
-## (def: #export test
-## Test
-## (<| (_.covering /._)
-## (_.for [/.Resolution])
-## ($_ _.and
-## (_.for [/.equivalence]
-## ($equivalence.spec /.equivalence ..random))
-
-## (_.cover [/.empty]
-## (dictionary.empty? /.empty))
-
-## ..one
-## ..any
-## ..all
-## )))
+(def: artifacts
+ (Random [Artifact Artifact Artifact])
+ (do random.monad
+ [dependee_artifact $///artifact.random
+ depender_artifact (random.filter (predicate.complement
+ (\ ///artifact.equivalence = dependee_artifact))
+ $///artifact.random)
+ ignored_artifact (random.filter (predicate.complement
+ (predicate.unite (\ ///artifact.equivalence = dependee_artifact)
+ (\ ///artifact.equivalence = depender_artifact)))
+ $///artifact.random)]
+ (wrap [dependee_artifact depender_artifact ignored_artifact])))
+
+(def: (packages [dependee_artifact depender_artifact ignored_artifact])
+ (-> [Artifact Artifact Artifact]
+ (Random [[Dependency Dependency Dependency]
+ [Package Package Package]]))
+ (do random.monad
+ [[_ dependee_package] $///package.random
+ [_ depender_package] $///package.random
+ [_ ignored_package] $///package.random
+
+ #let [dependee {#///dependency.artifact dependee_artifact
+ #///dependency.type ///artifact/type.lux_library}
+ depender {#///dependency.artifact depender_artifact
+ #///dependency.type ///artifact/type.lux_library}
+ ignored {#///dependency.artifact ignored_artifact
+ #///dependency.type ///artifact/type.lux_library}
+
+ dependee_pom (|> (\ ///.monoid identity)
+ (set@ #///.identity (#.Some dependee_artifact))
+ ///pom.write
+ try.assume)
+ depender_pom (|> (\ ///.monoid identity)
+ (set@ #///.identity (#.Some depender_artifact))
+ (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee)))
+ ///pom.write
+ try.assume)
+ ignored_pom (|> (\ ///.monoid identity)
+ (set@ #///.identity (#.Some ignored_artifact))
+ ///pom.write
+ try.assume)
+
+ dependee_package (set@ #///package.pom
+ [dependee_pom
+ (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode))
+ #///dependency/status.Unverified]
+ dependee_package)
+ depender_package (set@ #///package.pom
+ [depender_pom
+ (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode))
+ #///dependency/status.Unverified]
+ depender_package)
+ ignored_package (set@ #///package.pom
+ [ignored_pom
+ (|> ignored_pom (\ xml.codec encode) (\ utf8.codec encode))
+ #///dependency/status.Unverified]
+ ignored_package)]]
+ (wrap [[dependee depender ignored]
+ [dependee_package depender_package ignored_package]])))
+
+(def: all
+ Test
+ (do {! random.monad}
+ [[dependee_artifact depender_artifact ignored_artifact] ..artifacts
+
+ [[dependee depender ignored]
+ [dependee_package depender_package ignored_package]]
+ (..packages [dependee_artifact depender_artifact ignored_artifact])]
+ ($_ _.and
+ (wrap
+ (do promise.monad
+ [[successes failures resolution] (/.all (list (///repository.mock (..single dependee_artifact dependee_package) [])
+ (///repository.mock (..single depender_artifact depender_package) [])
+ (///repository.mock (..single ignored_artifact ignored_package) []))
+ (list depender)
+ /.empty)]
+ (_.cover' [/.all]
+ (and (dictionary.key? resolution depender)
+ (list.any? (///dependency\= depender) successes)
+
+ (dictionary.key? resolution dependee)
+ (list.any? (///dependency\= dependee) successes)
+
+ (list.empty? failures)
+ (not (dictionary.key? resolution ignored))))))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Resolution])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (_.cover [/.empty]
+ (dictionary.empty? /.empty))
+
+ ..one
+ ..any
+ ..all
+ )))
diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux
index e2751381a..86771cf1f 100644
--- a/stdlib/source/test/aedifex/input.lux
+++ b/stdlib/source/test/aedifex/input.lux
@@ -13,7 +13,8 @@
["." binary]
["." text
["%" format (#+ format)]
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
[collection
["." set (#+ Set)]]]
[math
@@ -28,7 +29,9 @@
["#" profile (#+ Profile)]
["#." project]
["#." action]
- ["#." format]]]})
+ ["#." format]
+ [repository
+ [remote (#+ Address)]]]]})
(def: (with_default_source sources)
(-> (Set //.Source) (Set //.Source))
@@ -36,6 +39,10 @@
(set.add //.default_source sources)
sources))
+(def: with_default_repository
+ (-> (Set Address) (Set Address))
+ (set.add //.default_repository))
+
(def: #export test
Test
(<| (_.covering /._)
@@ -50,12 +57,14 @@
_ (|> expected
//format.profile
%.code
- (\ encoding.utf8 encode)
+ (\ utf8.codec encode)
(!.use (\ file over_write)))
actual (: (Promise (Try Profile))
(/.read promise.monad fs //.default))]
(wrap (\ //.equivalence =
- (update@ #//.sources ..with_default_source expected)
+ (|> expected
+ (update@ #//.sources ..with_default_source)
+ (update@ #//.repositories ..with_default_repository))
actual)))]
(_.cover' [/.read]
(try.default false verdict)))))))
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index 403205dad..3645ef1bf 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -1,15 +1,16 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]]
+ [macro
+ ["." template]]
[math
["." random (#+ Random)]
[number
["n" nat]
- ["f" frac]
- ["." int]]]]
+ ["i" int]
+ ["f" frac]]]]
{1
["." /]}
["." / #_
@@ -21,71 +22,136 @@
["#/." continuous]
["#/." fuzzy]]])
-(def: margin
+(def: margin_of_error
+0.0000001)
(def: (trigonometric_symmetry forward backward angle)
(-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
(let [normal (|> angle forward backward)]
- (|> normal forward backward (f.approximately? margin normal))))
+ (|> normal forward backward (f.approximately? ..margin_of_error normal))))
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
($_ _.and
- (<| (_.context "Trigonometry")
- (do {! random.monad}
- [angle (|> random.safe_frac (\ ! map (f.* /.tau)))]
- ($_ _.and
- (_.test "Sine and arc-sine are inverse functions."
- (trigonometric_symmetry /.sin /.asin angle))
- (_.test "Cosine and arc-cosine are inverse functions."
- (trigonometric_symmetry /.cos /.acos angle))
- (_.test "Tangent and arc-tangent are inverse functions."
- (trigonometric_symmetry /.tan /.atan angle))
- )))
- (<| (_.context "Rounding")
- (do {! random.monad}
- [sample (|> random.safe_frac (\ ! map (f.* +1000.0)))]
- ($_ _.and
- (_.test "The ceiling will be an integer value, and will be >= the original."
- (let [ceil'd (/.ceil sample)]
- (and (|> ceil'd f.int int.frac (f.= ceil'd))
- (f.>= sample ceil'd)
- (f.<= +1.0 (f.- sample ceil'd)))))
- (_.test "The floor will be an integer value, and will be <= the original."
- (let [floor'd (/.floor sample)]
- (and (|> floor'd f.int int.frac (f.= floor'd))
- (f.<= sample floor'd)
- (f.<= +1.0 (f.- floor'd sample)))))
- (_.test "The round will be an integer value, and will be < or > or = the original."
- (let [round'd (/.round sample)]
- (and (|> round'd f.int int.frac (f.= round'd))
- (f.<= +1.0 (f.abs (f.- sample round'd))))))
- )))
- (<| (_.context "Exponentials and logarithms")
- (do {! random.monad}
- [sample (|> random.safe_frac (\ ! map (f.* +10.0)))]
- (_.test "Logarithm is the inverse of exponential."
- (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample)))))
- (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple")
- (do {! random.monad}
- [#let [gen_nat (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1))))]
- x gen_nat
- y gen_nat]
- ($_ _.and
- (_.test "GCD"
- (let [gcd (n.gcd x y)]
- (and (n.= 0 (n.% gcd x))
- (n.= 0 (n.% gcd y))
- (n.>= 1 gcd))))
+ (do {! random.monad}
+ [#let [~= (f.approximately? ..margin_of_error)]
+ angle (|> random.safe_frac (\ ! map (f.* /.tau)))]
+ ($_ _.and
+ (_.cover [/.sin /.asin]
+ (trigonometric_symmetry /.sin /.asin angle))
+ (_.cover [/.cos /.acos]
+ (trigonometric_symmetry /.cos /.acos angle))
+ (_.cover [/.tan /.atan]
+ (trigonometric_symmetry /.tan /.atan angle))
+ (_.cover [/.tau]
+ (and (and (~= +0.0 (/.sin /.tau))
+ (~= +1.0 (/.cos /.tau)))
+ (and (~= +0.0 (/.sin (f./ +2.0 /.tau)))
+ (~= -1.0 (/.cos (f./ +2.0 /.tau))))
+ (and (~= +1.0 (/.sin (f./ +4.0 /.tau)))
+ (~= +0.0 (/.cos (f./ +4.0 /.tau))))
+ (and (~= -1.0 (/.sin (f.* +3.0 (f./ +4.0 /.tau))))
+ (~= +0.0 (/.cos (f.* +3.0 (f./ +4.0 /.tau)))))
+ (let [x2+y2 (f.+ (/.pow +2.0 (/.sin angle))
+ (/.pow +2.0 (/.cos angle)))]
+ (~= +1.0 x2+y2))))
+ (_.cover [/.pi]
+ (~= (f./ +2.0 /.tau) /.pi))
+ ))
+ (do {! random.monad}
+ [sample (|> random.safe_frac (\ ! map (f.* +1000.0)))]
+ ($_ _.and
+ (_.cover [/.ceil]
+ (let [ceil'd (/.ceil sample)]
+ (and (|> ceil'd f.int i.frac (f.= ceil'd))
+ (f.>= sample ceil'd)
+ (f.<= +1.0 (f.- sample ceil'd)))))
+ (_.cover [/.floor]
+ (let [floor'd (/.floor sample)]
+ (and (|> floor'd f.int i.frac (f.= floor'd))
+ (f.<= sample floor'd)
+ (f.<= +1.0 (f.- floor'd sample)))))
+ (_.cover [/.round]
+ (let [round'd (/.round sample)]
+ (and (|> round'd f.int i.frac (f.= round'd))
+ (f.<= +1.0 (f.abs (f.- sample round'd))))))
+ ))
+ (do {! random.monad}
+ [#let [~= (f.approximately? ..margin_of_error)]
+ sample (\ ! map (f.* +10.0) random.safe_frac)
+ power (\ ! map (|>> (n.% 10) inc n.frac) random.nat)]
+ ($_ _.and
+ (_.cover [/.exp /.log]
+ (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample)))
+ (_.cover [/.e]
+ (~= +1.0 (/.log /.e)))
+ (_.cover [/.pow /.log']
+ (let [sample (f.abs sample)]
+ (|> sample
+ (/.pow power)
+ (/.log' sample)
+ (~= power))))
+ ))
+ (do {! random.monad}
+ [#let [~= (f.approximately? ..margin_of_error)]
+ angle (\ ! map (f.* /.tau) random.safe_frac)
+ sample (\ ! map f.abs random.safe_frac)
+ big (\ ! map (f.* +1,000,000,000.00) random.safe_frac)]
+ (template.with [(odd! <function>)
+ [(_.cover [<function>]
+ (~= (f.negate (<function> angle))
+ (<function> (f.negate angle))))]
- (_.test "LCM"
- (let [lcm (n.lcm x y)]
- (and (n.= 0 (n.% x lcm))
- (n.= 0 (n.% y lcm))
- (n.<= (n.* x y) lcm))))
- )))
+ (even! <function>)
+ [(_.cover [<function>]
+ (~= (<function> angle)
+ (<function> (f.negate angle))))]
+
+ (inverse! <left> <right> <input>)
+ [(_.cover [<left> <right>]
+ (~= (<right> <input>)
+ (<left> (f./ <input> +1.0))))]]
+ ($_ _.and
+ (odd! /.sinh)
+ (even! /.cosh)
+ (odd! /.tanh)
+ (odd! /.coth)
+ (even! /.sech)
+ (odd! /.csch)
+
+ (inverse! /.acosh /.asech sample)
+ (inverse! /.asinh /.acsch sample)
+ (inverse! /.atanh /.acoth big)
+ )))
+ (do {! random.monad}
+ [x (\ ! map (|>> (f.* +10.0) f.abs) random.safe_frac)
+ y (\ ! map (|>> (f.* +10.0) f.abs) random.safe_frac)]
+ (_.cover [/.hypotenuse]
+ (let [h (/.hypotenuse x y)]
+ (and (f.>= x h)
+ (f.>= y h)))))
+ (do {! random.monad}
+ [#let [~= (f.approximately? ..margin_of_error)
+ tau/4 (f./ +4.0 /.tau)]
+ x (\ ! map (f.* tau/4) random.safe_frac)
+ y (\ ! map (f.* tau/4) random.safe_frac)]
+ (_.cover [/.atan/2]
+ (let [expected (/.atan/2 x y)
+ actual (if (f.> +0.0 x)
+ (/.atan (f./ x y))
+ (if (f.< +0.0 y)
+ (f.- /.pi (/.atan (f./ x y)))
+ (f.+ /.pi (/.atan (f./ x y)))))]
+ (and (~= expected actual)
+ (~= tau/4 (/.atan/2 +0.0 (f.abs y)))
+ (~= (f.negate tau/4) (/.atan/2 +0.0 (f.negate (f.abs y))))
+ (f.not_a_number? (/.atan/2 +0.0 +0.0))))))
+ (do {! random.monad}
+ [of (\ ! map (|>> (n.% 10) inc) random.nat)]
+ (_.cover [/.factorial]
+ (and (n.= 1 (/.factorial 0))
+ (|> (/.factorial of) (n.% of) (n.= 0)))))
/infix.test
/modulus.test