aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2021-06-18 14:21:41 -0400
committerEduardo Julian2021-06-18 14:21:41 -0400
commita82bd1eabe94763162c2b0707d9c198fbe9835e3 (patch)
tree032473704af6e7db41e1f6dc87ab995788d8ab17 /stdlib/source
parent519c0c0c71cdf7ce3dfc64b9781ab826760b3d94 (diff)
Refactored the machinery to make local macros into its own module.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/function/mutual.lux91
-rw-r--r--stdlib/source/lux/ffi.jvm.lux12
-rw-r--r--stdlib/source/lux/ffi.old.lux12
-rw-r--r--stdlib/source/lux/macro.lux15
-rw-r--r--stdlib/source/lux/macro/local.lux105
-rw-r--r--stdlib/source/lux/macro/template.lux104
-rw-r--r--stdlib/source/lux/test.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux6
-rw-r--r--stdlib/source/lux/world/input/keyboard.lux44
-rw-r--r--stdlib/source/lux/world/shell.lux55
-rw-r--r--stdlib/source/program/aedifex/command/build.lux59
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux12
-rw-r--r--stdlib/source/program/aedifex/command/test.lux9
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux47
-rw-r--r--stdlib/source/program/aedifex/parser.lux2
-rw-r--r--stdlib/source/program/aedifex/runtime.lux14
-rw-r--r--stdlib/source/program/compositor.lux2
-rw-r--r--stdlib/source/program/compositor/static.lux4
-rw-r--r--stdlib/source/spec/aedifex/repository.lux4
-rw-r--r--stdlib/source/test/aedifex/command.lux30
-rw-r--r--stdlib/source/test/aedifex/command/build.lux9
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux36
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux43
-rw-r--r--stdlib/source/test/aedifex/command/test.lux4
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux232
-rw-r--r--stdlib/source/test/lux.lux3
-rw-r--r--stdlib/source/test/lux/macro.lux8
-rw-r--r--stdlib/source/test/lux/macro/local.lux90
-rw-r--r--stdlib/source/test/lux/macro/template.lux5
-rw-r--r--stdlib/source/test/lux/world.lux3
-rw-r--r--stdlib/source/test/lux/world/input/keyboard.lux144
-rw-r--r--stdlib/source/test/lux/world/output/video/resolution.lux16
35 files changed, 778 insertions, 452 deletions
diff --git a/stdlib/source/lux/control/function/mutual.lux b/stdlib/source/lux/control/function/mutual.lux
index 705545896..6ccbd2e63 100644
--- a/stdlib/source/lux/control/function/mutual.lux
+++ b/stdlib/source/lux/control/function/mutual.lux
@@ -17,6 +17,7 @@
[dictionary
["." plist (#+ PList)]]]]
["." macro
+ ["." local]
["." code]
[syntax (#+ syntax:)
["." export]
@@ -43,92 +44,6 @@
(function (~ (declaration.format (get@ #declaration mutual)))
(~ (get@ #body mutual)))))))
-(exception: #export (unknown_module {module Text})
- (exception.report
- ["Module" (%.text module)]))
-
-(template [<name>]
- [(exception: #export (<name> {module Text} {definition Text})
- (exception.report
- ["Module" (%.text module)]
- ["Definition" (%.text definition)]))]
-
- [cannot_shadow_definition]
- [unknown_definition]
- )
-
-(.def: (with_module name body)
- (All [a] (-> Text (-> Module (Try [Module a])) (Meta a)))
- (function (_ compiler)
- (case (|> compiler (get@ #.modules) (plist.get name))
- (#.Some module)
- (case (body module)
- (#try.Success [module' output])
- (#try.Success [(update@ #.modules (plist.put name module') compiler)
- output])
-
- (#try.Failure error)
- (#try.Failure error))
-
- #.None
- (exception.throw ..unknown_module [name]))))
-
-(.def: (push_one [name macro])
- (-> [Name Macro] (Meta Any))
- (do meta.monad
- [[module_name definition_name] (meta.normalize name)
- #let [definition (: Global (#.Definition [false .Macro (' {}) macro]))
- add_macro! (: (-> (PList Global) (PList Global))
- (plist.put definition_name definition))]]
- (..with_module module_name
- (function (_ module)
- (case (|> module (get@ #.definitions) (plist.get definition_name))
- #.None
- (#try.Success [(update@ #.definitions add_macro! module)
- []])
-
- (#.Some _)
- (exception.throw ..cannot_shadow_definition [module_name definition_name]))))))
-
-(.def: (pop_one name)
- (-> Name (Meta Any))
- (do meta.monad
- [[module_name definition_name] (meta.normalize name)
- #let [remove_macro! (: (-> (PList Global) (PList Global))
- (plist.remove definition_name))]]
- (..with_module module_name
- (function (_ module)
- (case (|> module (get@ #.definitions) (plist.get definition_name))
- (#.Some _)
- (#try.Success [(update@ #.definitions remove_macro! module)
- []])
-
- #.None
- (exception.throw ..unknown_definition [module_name definition_name]))))))
-
-(.def: (pop_all macros self)
- (-> (List Name) Name Macro)
- (<| (:coerce Macro)
- (: Macro')
- (function (_ _)
- (do {! meta.monad}
- [_ (monad.map ! ..pop_one macros)
- _ (..pop_one self)
- compiler meta.get_compiler]
- (wrap (case (get@ #.expected compiler)
- (#.Some _) (list (' []))
- #.None (list)))))))
-
-(.def: (push_all macros)
- (-> (List [Name Macro]) (Meta Code))
- (do meta.monad
- [_ (monad.map meta.monad ..push_one macros)
- seed meta.count
- g!pop (macro.gensym "pop")
- _ (.let [g!pop (: Name ["" (%.code g!pop)])]
- (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))]
- (wrap (` ((~ g!pop))))))
-
(.def: (macro g!context g!self)
(-> Code Code Macro)
(<| (:coerce Macro)
@@ -163,7 +78,7 @@
functions)
user_names (list\map (|>> (get@ [#declaration #declaration.name]) code.local_identifier)
functions)]
- g!pop (..push_all (list\map (function (_ [g!name mutual])
+ g!pop (local.push (list\map (function (_ [g!name mutual])
[[here_name (get@ [#declaration #declaration.name] mutual)]
(..macro g!context g!name)])
(list.zip/2 hidden_names
@@ -216,7 +131,7 @@
functions)
user_names (list\map (|>> (get@ [#mutual #declaration #declaration.name]) code.local_identifier)
functions)]
- g!pop (..push_all (list\map (function (_ [g!name mutual])
+ g!pop (local.push (list\map (function (_ [g!name mutual])
[[here_name (get@ [#mutual #declaration #declaration.name] mutual)]
(..macro g!context g!name)])
(list.zip/2 hidden_names
diff --git a/stdlib/source/lux/ffi.jvm.lux b/stdlib/source/lux/ffi.jvm.lux
index ad087f95b..4e684acf5 100644
--- a/stdlib/source/lux/ffi.jvm.lux
+++ b/stdlib/source/lux/ffi.jvm.lux
@@ -1530,12 +1530,14 @@
(def: (jvm_invoke_inputs mode classes inputs)
(-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code))
(|> inputs
- (list\map (function (_ [maybe? input])
- (if maybe?
- (` ((~! !!!) (~ (un_quote input))))
- (un_quote input))))
(list.zip/2 classes)
- (list\map (auto_convert_input mode))))
+ (list\map (function (_ [class [maybe? input]])
+ (|> (if maybe?
+ (` (: (.primitive (~ (code.text (..reflection class))))
+ ((~! !!!) (~ (un_quote input)))))
+ (un_quote input))
+ [class]
+ (auto_convert_input mode))))))
(def: (import_name format class member)
(-> Text Text Text Text)
diff --git a/stdlib/source/lux/ffi.old.lux b/stdlib/source/lux/ffi.old.lux
index 346fa4dc8..a867cd811 100644
--- a/stdlib/source/lux/ffi.old.lux
+++ b/stdlib/source/lux/ffi.old.lux
@@ -1417,8 +1417,8 @@
_
(\ meta.monad wrap [(list) (list) (list)])))
-(def: (decorate_return_maybe member return_term)
- (-> Import_Member_Declaration Code Code)
+(def: (decorate_return_maybe class member return_term)
+ (-> Class_Declaration Import_Member_Declaration Code Code)
(case member
(^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
(if (get@ #import_member_maybe? commons)
@@ -1428,7 +1428,9 @@
(if (not (..null? (:coerce (primitive "java.lang.Object")
(~ g!temp))))
(~ g!temp)
- (error! "Cannot produce null references from method calls."))))))
+ (error! (~ (code.text (format "Cannot produce null references from method calls @ "
+ (get@ #class_name class)
+ "." (get@ #import_member_alias commons))))))))))
_
return_term))
@@ -1532,7 +1534,7 @@
jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes)))
jvm_interop (|> (` ((~ jvm_extension)
(~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))
- (decorate_return_maybe member)
+ (decorate_return_maybe class member)
(decorate_return_try member)
(decorate_return_io member))]]
(wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
@@ -1565,7 +1567,7 @@
(` ((~ jvm_extension) (~+ (list\map un_quote object_ast))
(~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))]
(auto_convert_output (get@ #import_member_mode commons))
- (decorate_return_maybe member)
+ (decorate_return_maybe class member)
(decorate_return_try member)
(decorate_return_io member))]]
(wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 21caf5bae..e5a9ff9ef 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -86,6 +86,21 @@
[members' (monad.map //.monad expand_all members)]
(wrap (list (code.tuple (list\join members')))))
+ [_ (#.Record members)]
+ (|> members
+ (monad.map //.monad
+ (function (_ [left right])
+ (do //.monad
+ [left (expand_all left)
+ right (expand_all right)]
+ (case [left right]
+ [(#.Cons left #.Nil) (#.Cons right #.Nil)]
+ (wrap [left right])
+
+ _
+ (//.fail "Record members must expand into singletons.")))))
+ (\ //.monad map (|>> code.record list)))
+
_
(\ //.monad wrap (list syntax))))
diff --git a/stdlib/source/lux/macro/local.lux b/stdlib/source/lux/macro/local.lux
new file mode 100644
index 000000000..fc9e8bef5
--- /dev/null
+++ b/stdlib/source/lux/macro/local.lux
@@ -0,0 +1,105 @@
+(.module:
+ [lux #*
+ ["." meta]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]]
+ [data
+ ["." product]
+ ["." text]
+ [collection
+ ["." list ("#\." functor)]
+ [dictionary
+ ["." plist (#+ PList)]]]]]
+ ["." //
+ ["#." code]])
+
+(exception: #export (unknown_module {module Text})
+ (exception.report
+ ["Module" (text.format module)]))
+
+(template [<name>]
+ [(exception: #export (<name> {module Text} {definition Text})
+ (exception.report
+ ["Module" (text.format module)]
+ ["Definition" (text.format definition)]))]
+
+ [cannot_shadow_definition]
+ [unknown_definition]
+ )
+
+(def: (with_module name body)
+ (All [a] (-> Text (-> Module (Try [Module a])) (Meta a)))
+ (function (_ compiler)
+ (case (|> compiler (get@ #.modules) (plist.get name))
+ (#.Some module)
+ (case (body module)
+ (#try.Success [module' output])
+ (#try.Success [(update@ #.modules (plist.put name module') compiler)
+ output])
+
+ (#try.Failure error)
+ (#try.Failure error))
+
+ #.None
+ (exception.throw ..unknown_module [name]))))
+
+(def: (push_one [name macro])
+ (-> [Name Macro] (Meta Any))
+ (do meta.monad
+ [[module_name definition_name] (meta.normalize name)
+ #let [definition (: Global (#.Definition [false .Macro (' {}) macro]))
+ add_macro! (: (-> (PList Global) (PList Global))
+ (plist.put definition_name definition))]]
+ (..with_module module_name
+ (function (_ module)
+ (case (|> module (get@ #.definitions) (plist.get definition_name))
+ #.None
+ (#try.Success [(update@ #.definitions add_macro! module)
+ []])
+
+ (#.Some _)
+ (exception.throw ..cannot_shadow_definition [module_name definition_name]))))))
+
+(def: (pop_one name)
+ (-> Name (Meta Any))
+ (do meta.monad
+ [[module_name definition_name] (meta.normalize name)
+ #let [remove_macro! (: (-> (PList Global) (PList Global))
+ (plist.remove definition_name))]]
+ (..with_module module_name
+ (function (_ module)
+ (case (|> module (get@ #.definitions) (plist.get definition_name))
+ (#.Some _)
+ (#try.Success [(update@ #.definitions remove_macro! module)
+ []])
+
+ #.None
+ (exception.throw ..unknown_definition [module_name definition_name]))))))
+
+(def: (pop_all macros self)
+ (-> (List Name) Name Macro)
+ ("lux macro"
+ (function (_ _)
+ (do {! meta.monad}
+ [_ (monad.map ! ..pop_one macros)
+ _ (..pop_one self)
+ compiler meta.get_compiler]
+ (wrap (case (get@ #.expected compiler)
+ (#.Some _)
+ (list (' []))
+
+ #.None
+ (list)))))))
+
+(def: #export (push macros)
+ (-> (List [Name Macro]) (Meta Code))
+ (do meta.monad
+ [_ (monad.map meta.monad ..push_one macros)
+ seed meta.count
+ g!pop (//.gensym "pop")
+ _ (let [g!pop (: Name ["" (//code.format g!pop)])]
+ (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))]
+ (wrap (` ((~ g!pop))))))
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index d51af1d5c..6271b7cd4 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -12,9 +12,8 @@
["." bit ("#\." codec)]
["." text]
[collection
- ["." list ("#\." monad fold)]
- ["." dictionary (#+ Dictionary)
- ["." plist]]]]
+ ["." list ("#\." monad)]
+ ["." dictionary (#+ Dictionary)]]]
[math
[number
["." nat ("#\." decimal)]
@@ -23,7 +22,8 @@
["." frac ("#\." decimal)]]]]
["." //
[syntax (#+ syntax:)]
- ["." code]])
+ ["." code]
+ ["." local]])
(syntax: #export (splice {parts (<code>.tuple (<>.some <code>.any))})
(wrap parts))
@@ -106,7 +106,7 @@
(case (dictionary.get name env)
(#.Some substitute)
substitute
-
+
#.None
template)
@@ -137,16 +137,17 @@
["Actual" (\ nat.decimal encode actual)]))
(def: (macro (^slots [#parameters #template]))
- (-> Local Macro')
- (function (_ inputs compiler)
- (let [parameters_count (list.size parameters)
- inputs_count (list.size inputs)]
- (if (nat.= parameters_count inputs_count)
- (let [environment (: Environment
- (|> (list.zip/2 parameters inputs)
- (dictionary.from_list text.hash)))]
- (#.Right [compiler (list\map (..apply environment) template)]))
- (exception.throw ..irregular_arguments [parameters_count inputs_count])))))
+ (-> Local Macro)
+ ("lux macro"
+ (function (_ inputs compiler)
+ (let [parameters_count (list.size parameters)
+ inputs_count (list.size inputs)]
+ (if (nat.= parameters_count inputs_count)
+ (let [environment (: Environment
+ (|> (list.zip/2 parameters inputs)
+ (dictionary.from_list text.hash)))]
+ (#.Right [compiler (list\map (..apply environment) template)]))
+ (exception.throw ..irregular_arguments [parameters_count inputs_count]))))))
(def: local
(Parser Local)
@@ -158,61 +159,26 @@
#parameters parameters
#template template})))
-(exception: #export (cannot_shadow_definition {module Text} {definition Text})
- (exception.report
- ["Module" (text.format module)]
- ["Definition" (text.format definition)]))
-
-(def: (push module_name local module)
- (-> Text Local Module (Try Module))
- (let [definition (get@ #name local)]
- (case (plist.get definition (get@ #.definitions module))
- #.None
- (#try.Success (update@ #.definitions
- (plist.put definition
- (#.Definition [false .Macro (' {}) (..macro local)]))
- module))
-
- (#.Some _)
- (exception.throw ..cannot_shadow_definition [module_name definition]))))
-
-(syntax: (pop {locals (<>.some <code>.text)})
- (do meta.monad
- [here_name meta.current_module_name
- here meta.current_module]
- (function (_ compiler)
- (#.Right [(let [definitions (list\fold plist.remove
- (get@ #.definitions here)
- locals)]
- (update@ #.modules
- (plist.put here_name (set@ #.definitions definitions here))
- compiler))
- (case (get@ #.expected compiler)
- #.None
- (list)
-
- (#.Some _)
- (list (' [])))]))))
-
(syntax: #export (with {locals (<code>.tuple (<>.some ..local))}
body)
(do meta.monad
[here_name meta.current_module_name
- here meta.current_module]
- (//.with_gensyms [g!body]
- (function (_ compiler)
- (do try.monad
- [here (monad.fold try.monad (..push here_name) here locals)
- #let [compiler (update@ #.modules (plist.put here_name here) compiler)
- pop! (` ((~! ..pop) (~+ (list\map (|>> (get@ #name) code.text)
- locals))))]]
- (wrap [compiler
- (case (get@ #.expected compiler)
- #.None
- (list body
- pop!)
-
- (#.Some _)
- (list (` (let [(~ g!body) (~ body)]
- (exec (~ pop!)
- (~ g!body))))))]))))))
+ expression? (: (Meta Bit)
+ (function (_ lux)
+ (#try.Success [lux (case (get@ #.expected lux)
+ #.None
+ false
+
+ (#.Some _)
+ true)])))
+ g!pop (local.push (list\map (function (_ local)
+ [[here_name (get@ #name local)]
+ (..macro local)])
+ locals))]
+ (if expression?
+ (//.with_gensyms [g!body]
+ (wrap (list (` (let [(~ g!body) (~ body)]
+ (exec (~ g!pop)
+ (~ g!body)))))))
+ (wrap (list body
+ g!pop)))))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 4cf486c43..513765864 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -155,7 +155,7 @@
(exception: #export must_try_test_at_least_once)
## TODO: Figure out why tests sometimes freeze and fix it. Delete "times'" afterwards.
-(def: (times' millis_time_out amount test)
+(def: #export (times' millis_time_out amount test)
(-> (Maybe Nat) Nat Test Test)
(case amount
0 (..fail (exception.construct ..must_try_test_at_least_once []))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 781383df8..e697f62a9 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -1,6 +1,6 @@
(.module:
[lux (#- Module)
- ["@" target (#+ Host)]
+ ["@" target (#+ Target)]
[abstract
["." monad (#+ do)]]
[control
@@ -51,7 +51,7 @@
(def: #export (state target module expander host_analysis host generate generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender)
(All [anchor expression directive]
- (-> Host
+ (-> Target
Module
Expander
///analysis.Bundle
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index a89ddd43e..d505f5f7c 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -2,7 +2,7 @@
[lux (#- Module)
[type (#+ :share)]
["." debug]
- ["@" target (#+ Host)]
+ ["@" target]
[abstract
["." monad (#+ Monad do)]]
[control
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 4203516d4..bb5587dfe 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -934,7 +934,7 @@
(wrap [])
(do !
[from_class (phase.lift (reflection!.load from_name))]
- (phase.assert cannot_cast [fromT toT fromC]
+ (phase.assert ..cannot_cast [fromT toT fromC]
(java/lang/Class::isAssignableFrom from_class to_class))))]
(loop [[current_name currentT] [from_name fromT]]
(if (text\= to_name current_name)
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 8cf7fdcc2..7fe4b96a9 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -1,6 +1,6 @@
(.module:
[lux (#- Module)
- ["@" target (#+ Host)]
+ ["@" target (#+ Target)]
[abstract
[predicate (#+ Predicate)]
["." monad (#+ do)]]
@@ -171,11 +171,11 @@
(document.parser $.parser)))
(def: (fresh_analysis_state host)
- (-> Host .Lux)
+ (-> Target .Lux)
(analysis.state (analysis.info version.version host)))
(def: (analysis_state host archive)
- (-> Host Archive (Try .Lux))
+ (-> Target Archive (Try .Lux))
(do {! try.monad}
[modules (: (Try (List [Module .Module]))
(monad.map ! (function (_ module)
diff --git a/stdlib/source/lux/world/input/keyboard.lux b/stdlib/source/lux/world/input/keyboard.lux
index ccb90d30c..90068c197 100644
--- a/stdlib/source/lux/world/input/keyboard.lux
+++ b/stdlib/source/lux/world/input/keyboard.lux
@@ -7,16 +7,16 @@
(template [<code> <name>]
[(def: #export <name> Key <code>)]
- [00008 back-space]
+ [00008 back_space]
[00010 enter]
[00016 shift]
[00017 control]
[00018 alt]
- [00020 caps-lock]
+ [00020 caps_lock]
[00027 escape]
[00032 space]
- [00033 page-up]
- [00034 page-down]
+ [00033 page_up]
+ [00034 page_down]
[00035 end]
[00036 home]
@@ -52,21 +52,21 @@
[00089 y]
[00090 z]
- [00096 num-pad-0]
- [00097 num-pad-1]
- [00098 num-pad-2]
- [00099 num-pad-3]
- [00100 num-pad-4]
- [00101 num-pad-5]
- [00102 num-pad-6]
- [00103 num-pad-7]
- [00104 num-pad-8]
- [00105 num-pad-9]
+ [00096 num_pad_0]
+ [00097 num_pad_1]
+ [00098 num_pad_2]
+ [00099 num_pad_3]
+ [00100 num_pad_4]
+ [00101 num_pad_5]
+ [00102 num_pad_6]
+ [00103 num_pad_7]
+ [00104 num_pad_8]
+ [00105 num_pad_9]
[00127 delete]
- [00144 num-lock]
- [00145 scroll-lock]
- [00154 print-screen]
+ [00144 num_lock]
+ [00145 scroll_lock]
+ [00154 print_screen]
[00155 insert]
[00524 windows]
@@ -99,3 +99,13 @@
(type: #export Press
{#pressed? Bit
#input Key})
+
+(template [<bit> <name>]
+ [(def: #export (<name> key)
+ (-> Key Press)
+ {#pressed? <bit>
+ #input key})]
+
+ [#0 release]
+ [#1 press]
+ )
diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux
index dd6bc529d..77da2c9d8 100644
--- a/stdlib/source/lux/world/shell.lux
+++ b/stdlib/source/lux/world/shell.lux
@@ -7,6 +7,7 @@
[control
["." function]
["." try (#+ Try)]
+ ["." exception (#+ exception:)]
["." io (#+ IO)]
[security
["!" capability (#+ capability:)]
@@ -108,6 +109,7 @@
[process (!.use (\ shell execute) input)]
(wrap (..async_process process)))))))))
+## https://en.wikipedia.org/wiki/Code_injection#Shell_injection
(signature: (Policy ?)
(: (-> Command (Safe Command ?))
command)
@@ -220,7 +222,7 @@
(import: java/io/BufferedReader
["#::."
(new [java/io/Reader])
- (readLine [] #io #try java/lang/String)])
+ (readLine [] #io #try #? java/lang/String)])
(import: java/io/InputStream)
@@ -240,9 +242,11 @@
(destroy [] #io #try void)
(waitFor [] #io #try int)])
+ (exception: #export no_more_output)
+
(def: (default_process process)
(-> java/lang/Process (IO (Try (Process IO))))
- (do (try.with io.monad)
+ (do {! (try.with io.monad)}
[jvm_input (java/lang/Process::getInputStream process)
jvm_error (java/lang/Process::getErrorStream process)
jvm_output (java/lang/Process::getOutputStream process)
@@ -258,7 +262,14 @@
[(def: <name>
(..can_read
(function (_ _)
- (java/io/BufferedReader::readLine <stream>))))]
+ (do !
+ [output (java/io/BufferedReader::readLine <stream>)]
+ (case output
+ (#.Some output)
+ (wrap output)
+
+ #.None
+ (\ io.monad wrap (exception.throw ..no_more_output [])))))))]
[read jvm_input]
[error jvm_error]
@@ -300,39 +311,23 @@
(|>> java/lang/String::toLowerCase (text.starts_with? "windows"))
(java/lang/System::getProperty "os.name")))
- (def: (jvm::process_builder policy command arguments)
- (All [?]
- (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?))
- java/lang/ProcessBuilder))
- (|> (list\map (\ policy value) arguments)
- (list& (\ policy value command))
- ..jvm::arguments_array
- java/lang/ProcessBuilder::new))
-
(structure: #export default
(Shell IO)
(def: execute
(..can_execute
(function (_ [environment working_directory command arguments])
- (with_expansions [<jvm> (as_is (do {! (try.with io.monad)}
- [windows? ..windows?
- #let [builder (if windows?
- (..jvm::process_builder ..windows_policy
- (\ ..windows_policy command command)
- (list\map (\ ..windows_policy argument) arguments))
- (..jvm::process_builder ..unix_policy
- (\ ..unix_policy command command)
- (list\map (\ ..unix_policy argument) arguments)))]
- _ (|> builder
- (java/lang/ProcessBuilder::directory (java/io/File::new working_directory))
- java/lang/ProcessBuilder::environment
- (\ try.functor map (..jvm::load_environment environment))
- (\ io.monad wrap))
- process (java/lang/ProcessBuilder::start builder)]
- (..default_process process)))]
- (for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)}))))))
+ (do {! (try.with io.monad)}
+ [#let [builder (|> (list& command arguments)
+ ..jvm::arguments_array
+ java/lang/ProcessBuilder::new
+ (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))]
+ _ (|> builder
+ java/lang/ProcessBuilder::environment
+ (\ try.functor map (..jvm::load_environment environment))
+ (\ io.monad wrap))
+ process (java/lang/ProcessBuilder::start builder)]
+ (..default_process process))))))
)]
(for {@.old (as_is <jvm>)
@.jvm (as_is <jvm>)}
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 388a48c89..7052109fb 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -25,7 +25,7 @@
[world
[program (#+ Program)]
["." file (#+ Path)]
- ["." shell (#+ Shell)]
+ ["." shell (#+ Process Shell)]
["." console (#+ Console)]
[net
["." uri]]]]
@@ -79,8 +79,8 @@
(exception: #export no_specified_target)
(type: #export Compiler
- (#JVM Artifact)
- (#JS Artifact))
+ (#JVM Dependency)
+ (#JS Dependency))
(def: (remove_dependency dependency)
(-> Dependency (-> Resolution Resolution))
@@ -94,28 +94,30 @@
(..js_compiler resolution)]
[(#.Some dependency) _]
(#try.Success [(..remove_dependency dependency resolution)
- (#JVM (get@ #///dependency.artifact dependency))])
+ (#JVM dependency)])
[_ (#.Some dependency)]
(#try.Success [(..remove_dependency dependency resolution)
- (#JS (get@ #///dependency.artifact dependency))])
+ (#JS dependency)])
_
(exception.throw ..no_available_compiler [])))
-(def: (path fs home artifact)
- (All [!] (-> (file.System !) Path Artifact Path))
- (let [/ (\ fs separator)]
+(def: (path fs home dependency)
+ (All [!] (-> (file.System !) Path Dependency Path))
+ (let [/ (\ fs separator)
+ artifact (get@ #///dependency.artifact dependency)]
(|> artifact
(///local.uri (get@ #///artifact.version artifact))
(text.replace_all uri.separator /)
- (format home /))))
+ (format home /)
+ (text.suffix (format "." (get@ #///dependency.type dependency))))))
(def: (libraries fs home)
(All [!] (-> (file.System !) Path Resolution (List Path)))
(|>> dictionary.keys
(list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library)))
- (list\map (|>> (get@ #///dependency.artifact) (..path fs home)))))
+ (list\map (..path fs home))))
(def: (singular name)
(-> Text Text (List Text))
@@ -129,6 +131,26 @@
(def: #export success "[BUILD ENDED]")
(def: #export failure "[BUILD FAILED]")
+(template [<name> <capability>]
+ [(def: (<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)))))]
+
+ [log_output! read]
+ [log_error! error]
+ )
+
(def: #export (do! console program fs shell resolution profile)
(-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path]))
(case [(get@ #///.program profile)
@@ -146,12 +168,11 @@
working_directory (\ program directory [])]
(do ///action.monad
[[resolution compiler] (promise\wrap (..compiler resolution))
- #let [[command output] (let [[compiler output] (case compiler
- (#JVM artifact) [(///runtime.java (..path fs home artifact))
- "program.jar"]
- (#JS artifact) [(///runtime.node (..path fs home artifact))
- "program.js"])]
- [(format compiler " build") output])
+ #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)
@@ -159,10 +180,14 @@
[environment
working_directory
command
- (list.concat (list (..plural "--library" (..libraries fs home resolution))
+ (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
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
index 14b5d803f..d699de528 100644
--- a/stdlib/source/program/aedifex/command/deps.lux
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -12,7 +12,7 @@
["." list ("#\." fold)]
["." dictionary]]
[text
- ["%" format (#+ format)]]]
+ ["%" format]]]
[world
[program (#+ Program)]
["." file]
@@ -29,7 +29,7 @@
["#/." resolution (#+ Resolution)]
["#/." deployment]]]])
-(def: %dependency
+(def: format
(%.Format Dependency)
(|>> (get@ #///dependency.artifact)
///artifact.format
@@ -47,13 +47,13 @@
(///dependency/deployment.all local))
_ (console.write_line //clean.success console)
_ (console.write_line (exception.report
- ["Local successes" (exception.enumerate %dependency local_successes)]
- ["Local failures" (exception.enumerate %dependency local_failures)]
+ ["Local successes" (exception.enumerate ..format local_successes)]
+ ["Local failures" (exception.enumerate ..format local_failures)]
["Remote successes" (let [remote_successes (|> remote_successes
(set.from_list ///dependency.hash)
(set.difference (set.from_list ///dependency.hash local_successes))
set.to_list)]
- (exception.enumerate %dependency remote_successes))]
- ["Remote failures" (exception.enumerate %dependency remote_failures)])
+ (exception.enumerate ..format remote_successes))]
+ ["Remote failures" (exception.enumerate ..format remote_failures)])
console)]
(wrap resolution))))
diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux
index dff9b14ee..c3b517437 100644
--- a/stdlib/source/program/aedifex/command/test.lux
+++ b/stdlib/source/program/aedifex/command/test.lux
@@ -39,13 +39,14 @@
(do ///action.monad
[[compiler program] (//build.do! console program fs shell resolution profile)
_ (console.write_line ..start console)
+ #let [[compiler_command compiler_parameters] (case compiler
+ (#//build.JVM artifact) (///runtime.java program)
+ (#//build.JS artifact) (///runtime.node program))]
process (!.use (\ shell execute)
[environment
working_directory
- (case compiler
- (#//build.JVM artifact) (///runtime.java program)
- (#//build.JS artifact) (///runtime.node program))
- (list)])
+ compiler_command
+ compiler_parameters])
exit (!.use (\ process await) [])
_ (console.write_line (if (i.= shell.normal exit)
..success
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 89ad6368f..2d92e1438 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -196,7 +196,7 @@
failures
tail
resolution)
- _ (do promise.monad
+ _ (do {! promise.monad}
[?package (case (dictionary.get head resolution)
(#.Some package)
(wrap (#try.Success package))
@@ -205,23 +205,32 @@
(..any repositories head))]
(case ?package
(#try.Success package)
- (let [sub_dependencies (|> package
- ///package.dependencies
- (try\map set.to_list)
- (try.default (list)))
- sub_repositories (|> package
- ///package.repositories
- (try\map set.to_list)
- (try.default (list))
- (list\map (|>> (///repository/remote.repository #.None)
- ///repository.async))
- (list\compose repositories))]
- (|> resolution
- (dictionary.put head package)
- (recur sub_repositories
- (#.Cons head successes)
- failures
- sub_dependencies)))
+ (do !
+ [#let [sub_dependencies (|> package
+ ///package.dependencies
+ (try\map set.to_list)
+ (try.default (list)))
+ sub_repositories (|> package
+ ///package.repositories
+ (try\map set.to_list)
+ (try.default (list))
+ (list\map (|>> (///repository/remote.repository #.None)
+ ///repository.async))
+ (list\compose repositories))]
+ [successes failures resolution] (recur sub_repositories
+ (#.Cons head successes)
+ failures
+ sub_dependencies
+ (dictionary.put head package resolution))]
+ (recur repositories
+ successes
+ failures
+ tail
+ resolution))
(#try.Failure error)
- (wrap [successes (#.Cons head failures) resolution])))))))
+ (recur repositories
+ successes
+ (#.Cons head failures)
+ tail
+ resolution)))))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 411b4665b..046c8893c 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -215,7 +215,7 @@
^deploy_repositories (: (Parser (Dictionary Text //repository.Address))
(<| (\ ! map (dictionary.from_list text.hash))
(<>.default (list))
- (..singular input "deploy-repositories" ..deploy_repository)))]]
+ (..singular input "deploy_repositories" ..deploy_repository)))]]
($_ <>.and
^parents
^identity
diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux
index 6abfc5a62..42b1c315a 100644
--- a/stdlib/source/program/aedifex/runtime.lux
+++ b/stdlib/source/program/aedifex/runtime.lux
@@ -3,15 +3,17 @@
[data
[text
["%" format (#+ format)]]]
+ [macro
+ ["." template]]
[world
[file (#+ Path)]
[shell (#+ Command)]]])
-(template [<name> <command>]
- [(def: #export <name>
- (-> Path Command)
- (|>> (format <command>)))]
+(template [<name> <command> <parameters>]
+ [(def: #export (<name> path)
+ (-> Path [Text (List Text)])
+ (`` (format [<command> (list (~~ (template.splice <parameters>)) path)])))]
- [java "java -jar "]
- [node "node --stack_size=8192 "]
+ [java "java" ["-jar"]]
+ [node "node" ["--stack_size=8192"]]
)
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 03e9b281d..a6b85ccf0 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -2,7 +2,7 @@
[lux (#- Module)
[type (#+ :share)]
["." debug]
- ["@" target (#+ Host)]
+ ["@" target]
[abstract
[monad (#+ Monad do)]]
[control
diff --git a/stdlib/source/program/compositor/static.lux b/stdlib/source/program/compositor/static.lux
index 51bbef0e9..d5e100f30 100644
--- a/stdlib/source/program/compositor/static.lux
+++ b/stdlib/source/program/compositor/static.lux
@@ -1,11 +1,11 @@
(.module:
[lux #*
- [target (#+ Host)]
+ [target (#+ Target)]
[world
[file (#+ Path)]]])
(type: #export Static
- {#host Host
+ {#host Target
#host_module_extension Text
#target Path
#artifact_extension Text})
diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux
index 250bd3d01..1688f1e03 100644
--- a/stdlib/source/spec/aedifex/repository.lux
+++ b/stdlib/source/spec/aedifex/repository.lux
@@ -29,11 +29,11 @@
[expected (_binary.random 100)]
(wrap ($_ _.and'
(do promise.monad
- [#let [uri/good (/remote.uri valid_artifact //artifact/extension.lux_library)]
+ [#let [uri/good (/remote.uri (get@ #//artifact.version valid_artifact) valid_artifact //artifact/extension.lux_library)]
upload!/good (\ subject upload uri/good expected)
download!/good (\ subject download uri/good)
- #let [uri/bad (/remote.uri invalid_artifact //artifact/extension.lux_library)]
+ #let [uri/bad (/remote.uri (get@ #//artifact.version invalid_artifact) invalid_artifact //artifact/extension.lux_library)]
upload!/bad (\ subject upload uri/bad expected)
download!/bad (\ subject download uri/bad)]
(_.cover' [/.Repository]
diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux
index 0ef18f044..e0cb2da79 100644
--- a/stdlib/source/test/aedifex/command.lux
+++ b/stdlib/source/test/aedifex/command.lux
@@ -2,16 +2,19 @@
[lux #*
["_" test (#+ Test)]]
["." / #_
+ ["#." version]
+ ["#." pom]
+
["#." clean]
["#." install]
- ["#." pom]
- ["#." version]]
+
+ ["#." deps]
+ ["#." deploy]
+
+ ["#." build]
+ ["#." test]]
{#program
["." /
- ## ["#." deploy]
- ## ["#." deps]
- ## ["#." build]
- ## ["#." test]
## ["#." auto]
]})
@@ -20,13 +23,16 @@
(<| (_.covering /._)
(_.for [/.Command])
($_ _.and
+ /version.test
+ /pom.test
+
/clean.test
/install.test
- /pom.test
- /version.test
- ## /deploy.test
- ## /deps.test
- ## /build.test
- ## /test.test
+
+ /deps.test
+ /deploy.test
+
+ /build.test
+ /test.test
## /auto.test
)))
diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux
index 8a4df9a7e..85231ae33 100644
--- a/stdlib/source/test/aedifex/command/build.lux
+++ b/stdlib/source/test/aedifex/command/build.lux
@@ -4,6 +4,7 @@
[abstract
[monad (#+ do)]]
[control
+ [io (#+ IO)]
["." try]
["." exception]
[concurrency
@@ -37,7 +38,7 @@
["#/." resolution]]]]})
(def: #export good_shell
- (-> Any (Shell Promise))
+ (-> Any (Shell IO))
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
@@ -55,7 +56,7 @@
(#try.Success [state shell.normal]))))))))
(def: #export bad_shell
- (-> Any (Shell Promise))
+ (-> Any (Shell IO))
(shell.mock
(function (_ [actual_environment actual_working_directory actual_command actual_arguments])
(#try.Success
@@ -98,7 +99,7 @@
(<| (_.covering /._)
(do {! random.monad}
[#let [fs (file.mock (\ file.default separator))
- shell (..good_shell [])]
+ shell (shell.async (..good_shell []))]
program (random.ascii/alpha 5)
target (random.ascii/alpha 5)
home (random.ascii/alpha 5)
@@ -162,7 +163,7 @@
resolution ..resolution]
(wrap (do promise.monad
[verdict (do ///action.monad
- [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (..bad_shell []) resolution profile)
+ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile)
start (!.use (\ console read_line) [])
end (!.use (\ console read_line) [])]
(wrap (and (text\= /.start start)
diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux
index 617b3386a..cc99f2e48 100644
--- a/stdlib/source/test/aedifex/command/deploy.lux
+++ b/stdlib/source/test/aedifex/command/deploy.lux
@@ -17,7 +17,8 @@
["." binary]
["." text ("#\." equivalence)
["%" format (#+ format)]
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
["." format #_
["#" binary]
["." tar]
@@ -108,31 +109,42 @@
(export.library fs)
(\ ! map (format.run tar.writer)))
- actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom))
- actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library))
- actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1)))
- actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5)))
+ actual_pom (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.pom))
+ actual_library (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.lux_library))
+ actual_sha-1 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1)))
+ actual_sha-1 (\ promise.monad wrap
+ (do try.monad
+ [actual_sha-1 (\ utf8.codec decode actual_sha-1)]
+ (\ ///hash.sha-1_codec decode actual_sha-1)))
+ actual_md5 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5)))
+ actual_md5 (\ promise.monad wrap
+ (do try.monad
+ [actual_md5 (\ utf8.codec decode actual_md5)]
+ (\ ///hash.md5_codec decode actual_md5)))
- #let [deployed_library!
+ #let [succeeded!
+ (text\= //clean.success logging)
+
+ deployed_library!
(\ binary.equivalence =
expected_library
actual_library)
deployed_pom!
(\ binary.equivalence =
- (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode))
actual_pom)
deployed_sha-1!
- (\ binary.equivalence =
- (///hash.data (///hash.sha-1 expected_library))
+ (\ ///hash.equivalence =
+ (///hash.sha-1 expected_library)
actual_sha-1)
deployed_md5!
- (\ binary.equivalence =
- (///hash.data (///hash.md5 expected_library))
+ (\ ///hash.equivalence =
+ (///hash.md5 expected_library)
actual_md5)]]
- (wrap (and (text\= //clean.success logging)
+ (wrap (and succeeded!
deployed_library!
deployed_pom!
deployed_sha-1!
diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux
index 99856c83c..8b5e3820e 100644
--- a/stdlib/source/test/aedifex/command/deps.lux
+++ b/stdlib/source/test/aedifex/command/deps.lux
@@ -14,10 +14,14 @@
["." environment]]]
[data
["." text ("#\." equivalence)
- ["%" format (#+ format)]]
+ ["%" format (#+ format)]
+ [encoding
+ ["." utf8]]]
[collection
["." dictionary]
- ["." set]]]
+ ["." set]]
+ [format
+ ["." xml]]]
[math
["." random (#+ Random)]]
[world
@@ -81,10 +85,14 @@
dependee_package (|> dependee_package
(set@ #///package.origin (#///repository/origin.Remote ""))
- (set@ #///package.pom [dependee_pom #///dependency/status.Unverified]))
+ (set@ #///package.pom [dependee_pom
+ (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode))
+ #///dependency/status.Unverified]))
depender_package (|> depender_package
(set@ #///package.origin (#///repository/origin.Remote ""))
- (set@ #///package.pom [depender_pom #///dependency/status.Unverified]))
+ (set@ #///package.pom [depender_pom
+ (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode))
+ #///dependency/status.Unverified]))
fs (file.mock (\ file.default separator))
program (program.async (program.mock environment.empty home working_directory))]]
@@ -97,14 +105,29 @@
(///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)
+ []))))
logging! (\ ///action.monad map
(text\= //clean.success)
- (!.use (\ console read_line) []))]
+ (!.use (\ console read_line) []))
+
+ #let [had_dependee_before!
+ (set.member? pre dependee_artifact)
+
+ lacked_depender_before!
+ (not (set.member? pre depender_artifact))
+
+ had_dependee_after!
+ (dictionary.key? post dependee)
+
+ had_depender_after!
+ (dictionary.key? post depender)]]
(wrap (and logging!
- (and (set.member? pre dependee_artifact)
- (not (set.member? pre depender_artifact)))
- (and (dictionary.key? post dependee)
- (dictionary.key? post depender)))))]
+
+ had_dependee_before!
+ lacked_depender_before!
+
+ had_dependee_after!
+ had_depender_after!)))]
(_.cover' [/.do!]
(try.default false verdict)))))))
diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux
index 2d077ab87..9dd76ca08 100644
--- a/stdlib/source/test/aedifex/command/test.lux
+++ b/stdlib/source/test/aedifex/command/test.lux
@@ -62,7 +62,7 @@
console (@version.echo "")]
(wrap (do promise.monad
[verdict (do ///action.monad
- [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (@build.good_shell []) resolution profile)
+ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile)
build_start (!.use (\ console read_line) [])
build_end (!.use (\ console read_line) [])
test_start (!.use (\ console read_line) [])
@@ -96,7 +96,7 @@
shell.normal
shell.error)]))))))
[])]
- _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs bad_shell resolution profile)
+ _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile)
build_start (!.use (\ console read_line) [])
build_end (!.use (\ console read_line) [])
test_start (!.use (\ console read_line) [])
diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux
index 4404cb32f..e9cd26a82 100644
--- a/stdlib/source/test/aedifex/dependency/resolution.lux
+++ b/stdlib/source/test/aedifex/dependency/resolution.lux
@@ -16,7 +16,8 @@
["." product]
["." binary]
["." text
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
[format
["." xml]]
[collection
@@ -59,38 +60,39 @@
(def: #export (single artifact package)
(-> Artifact Package (Simulation Any))
- (structure
- (def: (on_download uri state)
- (if (text.contains? (///artifact.uri artifact) uri)
- (cond (text.ends_with? ///artifact/extension.lux_library uri)
- (#try.Success [state (|> package
- (get@ #///package.library)
- product.left)])
-
- (text.ends_with? ///artifact/extension.pom uri)
- (#try.Success [state (|> package
- (get@ #///package.pom)
- product.left
- (\ xml.codec encode)
- (\ encoding.utf8 encode))])
+ (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)]
+ (structure
+ (def: (on_download uri state)
+ (if (text.contains? expected uri)
+ (cond (text.ends_with? ///artifact/extension.lux_library uri)
+ (#try.Success [state (|> package
+ (get@ #///package.library)
+ product.left)])
+
+ (text.ends_with? ///artifact/extension.pom uri)
+ (#try.Success [state (|> package
+ (get@ #///package.pom)
+ product.left
+ (\ xml.codec encode)
+ (\ utf8.codec encode))])
- ## (text.ends_with? ///artifact/extension.sha-1 uri)
- ## (#try.Success [state (|> package
- ## (get@ #///package.sha-1)
- ## (\ ///hash.sha-1_codec encode)
- ## (\ encoding.utf8 encode))])
-
- ## (text.ends_with? ///artifact/extension.md5 uri)
- ## (#try.Success [state (|> package
- ## (get@ #///package.md5)
- ## (\ ///hash.md5_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (text.ends_with? ///artifact/extension.sha-1 uri)
+ ## (#try.Success [state (|> package
+ ## (get@ #///package.sha-1)
+ ## (\ ///hash.sha-1_codec encode)
+ ## (\ utf8.codec encode))])
+
+ ## (text.ends_with? ///artifact/extension.md5 uri)
+ ## (#try.Success [state (|> 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"))))
+ ## else
+ (#try.Failure "NOPE"))
+ (#try.Failure "NOPE")))
+ (def: (on_upload uri binary state)
+ (#try.Failure "NOPE")))))
(def: one
Test
@@ -106,7 +108,7 @@
bad_sha-1 (: (Simulation Any)
(structure
(def: (on_download uri state)
- (if (text.contains? (///artifact.uri expected_artifact) uri)
+ (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)
@@ -117,19 +119,19 @@
(get@ #///package.pom)
product.left
(\ xml.codec encode)
- (\ encoding.utf8 encode))])
+ (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.sha-1)
## (#try.Success [state (|> dummy_package
## (get@ #///package.sha-1)
## (\ ///hash.sha-1_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.md5)
## (#try.Success [state (|> expected_package
## (get@ #///package.md5)
## (\ ///hash.md5_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## else
(#try.Failure "NOPE"))
@@ -139,7 +141,7 @@
bad_md5 (: (Simulation Any)
(structure
(def: (on_download uri state)
- (if (text.contains? (///artifact.uri expected_artifact) uri)
+ (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)
@@ -150,19 +152,19 @@
(get@ #///package.pom)
product.left
(\ xml.codec encode)
- (\ encoding.utf8 encode))])
+ (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.sha-1)
## (#try.Success [state (|> expected_package
## (get@ #///package.sha-1)
## (\ ///hash.sha-1_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.md5)
## (#try.Success [state (|> dummy_package
## (get@ #///package.md5)
## (\ ///hash.md5_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## else
(#try.Failure "NOPE"))
@@ -217,7 +219,7 @@
bad_sha-1 (: (Simulation Any)
(structure
(def: (on_download uri state)
- (if (text.contains? (///artifact.uri expected_artifact) uri)
+ (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)
@@ -228,19 +230,19 @@
(get@ #///package.pom)
product.left
(\ xml.codec encode)
- (\ encoding.utf8 encode))])
+ (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.sha-1)
## (#try.Success [state (|> dummy_package
## (get@ #///package.sha-1)
## (\ ///hash.sha-1_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.md5)
## (#try.Success [state (|> expected_package
## (get@ #///package.md5)
## (\ ///hash.md5_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## else
(#try.Failure "NOPE"))
@@ -250,7 +252,7 @@
bad_md5 (: (Simulation Any)
(structure
(def: (on_download uri state)
- (if (text.contains? (///artifact.uri expected_artifact) uri)
+ (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)
@@ -261,19 +263,19 @@
(get@ #///package.pom)
product.left
(\ xml.codec encode)
- (\ encoding.utf8 encode))])
+ (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.sha-1)
## (#try.Success [state (|> expected_package
## (get@ #///package.sha-1)
## (\ ///hash.sha-1_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## (text\= extension ///artifact/extension.md5)
## (#try.Success [state (|> dummy_package
## (get@ #///package.md5)
## (\ ///hash.md5_codec encode)
- ## (\ encoding.utf8 encode))])
+ ## (\ utf8.codec encode))])
## else
(#try.Failure "NOPE"))
@@ -312,77 +314,77 @@
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)
+## (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
+## [_ 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}
+## #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)))
+## 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)
- (#try.Failure error)
- false))))
- )))
+## 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)))
-(def: #export test
- Test
- (<| (_.covering /._)
- (_.for [/.Resolution])
- ($_ _.and
- (_.for [/.equivalence]
- ($equivalence.spec /.equivalence ..random))
+## (#try.Failure error)
+## false))))
+## )))
+
+## (def: #export test
+## Test
+## (<| (_.covering /._)
+## (_.for [/.Resolution])
+## ($_ _.and
+## (_.for [/.equivalence]
+## ($equivalence.spec /.equivalence ..random))
+
+## (_.cover [/.empty]
+## (dictionary.empty? /.empty))
- (_.cover [/.empty]
- (dictionary.empty? /.empty))
-
- ..one
- ..any
- ..all
- )))
+## ..one
+## ..any
+## ..all
+## )))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index ad63d30cb..69ce89d45 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -7,7 +7,6 @@
[program (#+ program:)]
["_" test (#+ Test)]
["@" target]
- ["." debug]
[abstract
[monad (#+ do)]
[predicate (#+ Predicate)]]
@@ -256,5 +255,5 @@
(program: args
(<| io
_.run!
- ((debug.private _.times') (#.Some 2,000) 100)
+ (_.times' (#.Some 2,000) 100)
..test))
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index d4e3e9ae4..5892f842e 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -27,9 +27,10 @@
["." template]]}
["." / #_
["#." code]
- ["#." template]
+ ["#." local]
["#." poly]
- ["#." syntax]])
+ ["#." syntax]
+ ["#." template]])
(template: (!expect <pattern> <value>)
(case <value>
@@ -179,7 +180,8 @@
..expander
/code.test
- /template.test
+ /local.test
/syntax.test
/poly.test
+ /template.test
)))
diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux
new file mode 100644
index 000000000..b499beb68
--- /dev/null
+++ b/stdlib/source/test/lux/macro/local.lux
@@ -0,0 +1,90 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ ["." meta]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]
+ ["<>" parser
+ ["<.>" code]]]
+ [data
+ [text
+ ["%" format]]
+ [collection
+ ["." list]
+ [dictionary
+ ["." plist]]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /]})
+
+(syntax: (macro_error macro)
+ (function (_ compiler)
+ (case ((macro.expand macro) compiler)
+ (#try.Failure error)
+ (#try.Success [compiler (list (code.text error))])
+
+ (#try.Success _)
+ (#try.Failure "OOPS!"))))
+
+(def: (constant output)
+ (-> Code Macro)
+ ("lux macro"
+ (function (_ inputs lux)
+ (#try.Success [lux (list output)]))))
+
+(syntax: (with {name (<code>.tuple (<>.and <code>.text <code>.text))}
+ constant
+ {pre_remove <code>.bit}
+ body)
+ (macro.with_gensyms [g!output]
+ (do meta.monad
+ [pop! (/.push (list [name (..constant constant)]))
+ [module short] (meta.normalize name)
+ _ (if pre_remove
+ (let [remove_macro! (: (-> .Module .Module)
+ (update@ #.definitions (plist.remove short)))]
+ (function (_ lux)
+ (#try.Success [(update@ #.modules (plist.update module remove_macro!) lux)
+ []])))
+ (wrap []))]
+ (let [pre_expansion (` (let [(~ g!output) (~ body)]
+ (exec (~ pop!)
+ (~ g!output))))]
+ (if pre_remove
+ (macro.expand_all pre_expansion)
+ (wrap (list pre_expansion)))))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [expected random.nat]
+ ($_ _.and
+ (_.cover [/.push]
+ (..with ["" "actual"] expected #0
+ (n.= expected (..actual))))
+ (_.cover [/.unknown_module]
+ (exception.match? /.unknown_module
+ (..macro_error
+ (..with ["123yolo456" "actual"] expected #0
+ (n.= expected (..actual))))))
+ (_.cover [/.cannot_shadow_definition]
+ (exception.match? /.cannot_shadow_definition
+ (..macro_error
+ (..with ["" "with"] expected #0
+ (n.= expected (..actual))))))
+ (_.cover [/.unknown_definition]
+ (exception.match? /.unknown_definition
+ (<| ..macro_error
+ (..with ["" "actual"] expected #1)
+ (n.= expected (..actual)))))
+ ))))
diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux
index 8f85ff3ea..9f8b5af6c 100644
--- a/stdlib/source/test/lux/macro/template.lux
+++ b/stdlib/source/test/lux/macro/template.lux
@@ -117,10 +117,5 @@
[""]]
(exception.match? /.irregular_arguments
(macro_error (arity/3 "a" "b")))))
- (_.cover [/.cannot_shadow_definition]
- (exception.match? /.cannot_shadow_definition
- (macro_error (/.with [(macro_error <0> <1> <2>)
- [""]]
- ""))))
)))
))
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index 8b560ca40..62e0fc397 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -6,6 +6,8 @@
["#." shell]
["#." console]
["#." program]
+ ["#." input #_
+ ["#/." keyboard]]
["#." output #_
["#/." video #_
["#/." resolution]]]])
@@ -17,5 +19,6 @@
/shell.test
/console.test
/program.test
+ /input/keyboard.test
/output/video/resolution.test
))
diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux
new file mode 100644
index 000000000..e38ce6271
--- /dev/null
+++ b/stdlib/source/test/lux/world/input/keyboard.lux
@@ -0,0 +1,144 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." bit ("#\." equivalence)]
+ ["." maybe]
+ [collection
+ ["." list]
+ ["." set (#+ Set)]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /]})
+
+(with_expansions [<keys> (as_is /.back_space
+ /.enter
+ /.shift
+ /.control
+ /.alt
+ /.caps_lock
+ /.escape
+ /.space
+ /.page_up
+ /.page_down
+ /.end
+ /.home
+
+ /.left
+ /.up
+ /.right
+ /.down
+
+ /.a
+ /.b
+ /.c
+ /.d
+ /.e
+ /.f
+ /.g
+ /.h
+ /.i
+ /.j
+ /.k
+ /.l
+ /.m
+ /.n
+ /.o
+ /.p
+ /.q
+ /.r
+ /.s
+ /.t
+ /.u
+ /.v
+ /.w
+ /.x
+ /.y
+ /.z
+
+ /.num_pad_0
+ /.num_pad_1
+ /.num_pad_2
+ /.num_pad_3
+ /.num_pad_4
+ /.num_pad_5
+ /.num_pad_6
+ /.num_pad_7
+ /.num_pad_8
+ /.num_pad_9
+
+ /.delete
+ /.num_lock
+ /.scroll_lock
+ /.print_screen
+ /.insert
+ /.windows
+
+ /.f1
+ /.f2
+ /.f3
+ /.f4
+ /.f5
+ /.f6
+ /.f7
+ /.f8
+ /.f9
+ /.f10
+ /.f11
+ /.f12
+ /.f13
+ /.f14
+ /.f15
+ /.f16
+ /.f17
+ /.f18
+ /.f19
+ /.f20
+ /.f21
+ /.f22
+ /.f23
+ /.f24)]
+ (def: listing
+ (List /.Key)
+ (list <keys>))
+
+ (def: catalogue
+ (Set /.Key)
+ (set.from_list n.hash ..listing))
+
+ (def: #export random
+ (Random /.Key)
+ (let [count (list.size ..listing)]
+ (do {! random.monad}
+ [choice (\ ! map (n.% count) random.nat)]
+ (wrap (maybe.assume (list.nth choice ..listing))))))
+
+ (def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Key])
+ ($_ _.and
+ (_.cover [<keys>]
+ (n.= (list.size ..listing)
+ (set.size ..catalogue)))
+
+ (_.for [/.Press]
+ (`` ($_ _.and
+ (~~ (template [<pressed?> <function>]
+ [(do random.monad
+ [key ..random
+ #let [sample (<function> key)]]
+ (_.cover [<function>]
+ (and (bit\= <pressed?> (get@ #/.pressed? sample))
+ (n.= key (get@ #/.input sample)))))]
+
+ [#0 /.release]
+ [#1 /.press]
+ ))
+ )))
+ ))))
diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux
index f5dcf5380..b7684ed2f 100644
--- a/stdlib/source/test/lux/world/output/video/resolution.lux
+++ b/stdlib/source/test/lux/world/output/video/resolution.lux
@@ -34,17 +34,20 @@
/.wuxga
/.wqhd
/.uhd-4k)]
+ (def: listing
+ (List /.Resolution)
+ (list <resolutions>))
+
(def: catalogue
(Set /.Resolution)
- (set.from_list /.hash (list <resolutions>)))
+ (set.from_list /.hash ..listing))
(def: #export random
(Random /.Resolution)
- (let [listing (set.to_list catalogue)
- count (list.size listing)]
+ (let [count (list.size ..listing)]
(do {! random.monad}
[choice (\ ! map (n.% count) random.nat)]
- (wrap (maybe.assume (list.nth choice listing))))))
+ (wrap (maybe.assume (list.nth choice ..listing))))))
(def: #export test
Test
@@ -57,7 +60,6 @@
($hash.spec /.hash ..random))
(_.cover [<resolutions>]
- (let [listing (set.to_list catalogue)]
- (n.= (list.size listing)
- (set.size catalogue))))
+ (n.= (list.size ..listing)
+ (set.size ..catalogue)))
))))