diff options
| author | Eduardo Julian | 2021-07-02 03:11:36 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-07-02 03:11:36 -0400 |
| commit | 5cf4efa861075f8276f43a2516f5beacaf610b44 (patch) | |
| tree | e21cf528d960c29d22cbc7e41180fa09e62f16d6 /stdlib | |
| parent | 744ee69630de59ca3ba660b0aab6361cd17ce1b4 (diff) | |
No longer employing the capabilities model on the lux/world/* modules.
Capabilities should be opt-in, but using them in the standard library makes them mandatory.
Diffstat (limited to 'stdlib')
58 files changed, 1937 insertions, 1861 deletions
diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux index 25afafd5e..1d3c0e43e 100644 --- a/stdlib/source/lux/control/security/policy.lux +++ b/stdlib/source/lux/control/security/policy.lux @@ -5,20 +5,18 @@ [apply (#+ Apply)] [monad (#+ Monad)]] [type - abstract]] - [// - ["!" capability (#+ capability:)]]) + abstract]]) (abstract: #export (Policy brand value label) value - (capability: #export (Can_Upgrade brand label value) + (type: #export (Can_Upgrade brand label value) {#.doc (doc "Represents the capacity to 'upgrade' a value.")} - (can_upgrade value (Policy brand value label))) + (-> value (Policy brand value label))) - (capability: #export (Can_Downgrade brand label value) + (type: #export (Can_Downgrade brand label value) {#.doc (doc "Represents the capacity to 'downgrade' a value.")} - (can_downgrade (Policy brand value label) value)) + (-> (Policy brand value label) value)) (type: #export (Privilege brand label) {#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")} @@ -27,8 +25,8 @@ (def: privilege Privilege - {#can_upgrade (..can_upgrade (|>> :abstraction)) - #can_downgrade (..can_downgrade (|>> :representation))}) + {#can_upgrade (|>> :abstraction) + #can_downgrade (|>> :representation)}) (type: #export (Delegation brand from to) {#.doc (doc "Represents the act of delegating policy capacities.")} @@ -41,7 +39,7 @@ (All [brand from to] (-> (Can_Downgrade brand from) (Can_Upgrade brand to) (Delegation brand from to))) - (|>> (!.use downgrade) (!.use upgrade))) + (|>> downgrade upgrade)) (type: #export (Context brand scope label) {#.doc (doc "A computational context with an associated policy privilege.")} diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux index f429b0442..659dc0799 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux @@ -4,9 +4,7 @@ [monad (#+ do)]] [control ["." io (#+ IO)] - ["." try (#+ Try)] - [security - ["!" capability]]] + ["." try (#+ Try)]] [data [binary (#+ Binary)] [text @@ -23,7 +21,7 @@ [outcome (do (try.with @) [file (: (IO (Try (File IO))) (file.get-file io.monad file.default file-path))] - (!.use (\ file over-write) bytecode))] + (\ file over-write bytecode))] (wrap (case outcome (#try.Success definition) file-path diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index e611f9f47..2006fcd79 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -9,10 +9,8 @@ ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability (#+ capability:)]] ["<>" parser - ["<b>" binary (#+ Parser)]]] + ["<.>" binary (#+ Parser)]]] [data [binary (#+ Binary)] ["." product] @@ -100,7 +98,7 @@ (do ! [_ (file.get_directory ! system (..unversioned_lux_archive system static)) _ (file.get_directory ! system (..versioned_lux_archive system static)) - outcome (!.use (\ system create_directory) module)] + outcome (\ system create_directory module)] (case outcome (#try.Success output) (wrap (#try.Success [])) @@ -116,7 +114,7 @@ [artifact (: (Promise (Try (File Promise))) (file.get_file promise.monad system (..artifact system static module_id artifact_id)))] - (!.use (\ artifact over_write) content))) + (\ artifact over_write content))) (def: #export (enable system static) (-> (file.System Promise) Static (Promise (Try Any))) @@ -138,7 +136,7 @@ (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) (file.get_file promise.monad system (..general_descriptor system static)))] - (!.use (\ file over_write) (archive.export ///.version archive)))) + (\ file over_write (archive.export ///.version archive)))) (def: module_descriptor_file "module_descriptor") @@ -155,7 +153,7 @@ [file (: (Promise (Try (File Promise))) (file.get_file promise.monad system (..module_descriptor system static module_id)))] - (!.use (\ file over_write) content))) + (\ file over_write content))) (def: (read_module_descriptor system static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try Binary))) @@ -163,7 +161,7 @@ [file (: (Promise (Try (File Promise))) (file.get_file promise.monad system (..module_descriptor system static module_id)))] - (!.use (\ file content) []))) + (\ file content []))) (def: parser (Parser [Descriptor (Document .Module)]) @@ -189,19 +187,19 @@ (def: (cached_artifacts system static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary)))) (do {! (try.with promise.monad)} - [module_dir (!.use (\ system directory) (..module system static module_id)) - cached_files (!.use (\ module_dir files) [])] + [module_dir (\ system directory (..module system static module_id)) + cached_files (\ module_dir files [])] (|> cached_files (list\map (function (_ file) - [(file.name system (!.use (\ file path) [])) - (!.use (\ file path) [])])) + [(file.name system (\ file path)) + (\ file path)])) (list.filter (|>> product.left (text\= ..module_descriptor_file) not)) (monad.map ! (function (_ [name path]) (do ! [file (: (Promise (Try (File Promise))) - (!.use (\ system file) path)) + (\ system file path)) data (: (Promise (Try Binary)) - (!.use (\ file content) []))] + (\ file content []))] (wrap [name data])))) (\ ! map (dictionary.from_list text.hash))))) @@ -338,12 +336,12 @@ (def: (purge! system static [module_name module_id]) (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any))) (do {! (try.with promise.monad)} - [cache (!.use (\ system directory) [(..module system static module_id)]) - artifacts (!.use (\ cache files) []) + [cache (\ system directory (..module system static module_id)) + artifacts (\ cache files []) _ (monad.map ! (function (_ artifact) - (!.use (\ artifact delete) [])) + (\ artifact delete [])) artifacts)] - (!.use (\ cache discard) []))) + (\ cache discard []))) (def: (valid_cache? expected actual) (-> Descriptor Input Bit) @@ -398,7 +396,7 @@ (monad.map ! (function (_ [module_name module_id]) (do ! [data (..read_module_descriptor system static module_id) - [descriptor document] (promise\wrap (<b>.run ..parser data))] + [descriptor document] (promise\wrap (<binary>.run ..parser data))] (if (text\= archive.runtime_module module_name) (wrap [true [module_name [module_id [descriptor document (: Output row.empty)]]]]) @@ -451,11 +449,11 @@ (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) (Promise (Try [Archive .Lux Bundles])))) (do promise.monad - [file (!.use (\ system file) (..general_descriptor system static))] + [file (\ system file (..general_descriptor system static))] (case file (#try.Success file) (do (try.with promise.monad) - [binary (!.use (\ file content) []) + [binary (\ file content []) archive (promise\wrap (archive.import ///.version binary))] (..load_every_reserved_module host_environment system static import contexts archive)) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 33f201571..788be9fed 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -7,8 +7,6 @@ [control ["." try (#+ Try)] ["." exception (#+ exception:)] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -62,7 +60,7 @@ (#.Cons context contexts') (do promise.monad [#let [path (format (..path system context module) extension)] - file (!.use (\ system file) [path])] + file (\ system file [path])] (case file (#try.Success file) (wrap (#try.Success [path file])) @@ -84,13 +82,13 @@ (case outcome (#try.Success [path file]) (do (try.with !) - [data (!.use (\ file content) [])] + [data (\ file content [])] (wrap [path data])) (#try.Failure _) (do (try.with !) [[path file] (..find_source_file system importer contexts module ..lux_extension) - data (!.use (\ file content) [])] + data (\ file content [])] (wrap [path data]))))) (def: (find_library_source_file importer import partial_host_extension module) @@ -159,23 +157,23 @@ (def: (enumerate_context system context enumeration) (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) (do {! (try.with promise.monad)} - [directory (!.use (\ system directory) [context])] + [directory (\ system directory context)] (loop [directory directory enumeration enumeration] (do ! - [files (!.use (\ directory files) []) + [files (\ directory files []) enumeration (monad.fold ! (function (_ file enumeration) - (let [path (!.use (\ file path) [])] + (let [path (\ file path)] (if (text.ends_with? ..lux_extension path) (do ! [path (promise\wrap (..clean_path system context path)) - source_code (!.use (\ file content) [])] + source_code (\ file content [])] (promise\wrap (dictionary.try_put path source_code enumeration))) (wrap enumeration)))) enumeration files) - directories (!.use (\ directory directories) [])] + directories (\ directory directories [])] (monad.fold ! recur enumeration directories))))) (def: Action diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index 1df76453c..86cec2ba1 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -7,9 +7,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." binary (#+ Binary)] ["." text diff --git a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux index 64d7418eb..153aa79b5 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux @@ -4,9 +4,7 @@ [abstract ["." monad (#+ Monad do)]] [control - ["." try (#+ Try)] - [security - ["!" capability]]] + ["." try (#+ Try)]] [data [binary (#+ Binary)] ["." product] diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index c23688a9e..5ddeac0d5 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -4,9 +4,7 @@ [abstract ["." monad (#+ Monad do)]] [control - ["." try (#+ Try)] - [security - ["!" capability]]] + ["." try (#+ Try)]] [data [binary (#+ Binary)] ["." product] diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index d4a16e5f6..93842b99a 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -10,9 +10,7 @@ ["." io (#+ IO io)] [concurrency ["." promise (#+ Promise)] - ["." atom]] - [security - ["!" capability (#+ capability:)]]] + ["." atom]]] [data ["." text (#+ Char) ["%" format (#+ format)]]]]) @@ -25,37 +23,27 @@ [cannot_close] ) -(capability: #export (Can_Read ! o) - (can_read [] (! (Try o)))) - -(capability: #export (Can_Write ! i) - (can_write i (! (Try Any)))) - -(capability: #export (Can_Close !) - (can_close [] (! (Try Any)))) - (interface: #export (Console !) - (: (Can_Read ! Char) + (: (-> [] (! (Try Char))) read) - (: (Can_Read ! Text) + (: (-> [] (! (Try Text))) read_line) - (: (Can_Write ! Text) + (: (-> Text (! (Try Any))) write) - (: (Can_Close !) + (: (-> [] (! (Try Any))) close)) (def: #export (async console) (-> (Console IO) (Console Promise)) (`` (implementation - (~~ (template [<capability> <forge>] + (~~ (template [<capability>] [(def: <capability> - (<forge> - (|>> (!.use (\ console <capability>)) promise.future)))] + (|>> (\ console <capability>) promise.future))] - [read ..can_read] - [read_line ..can_read] - [write ..can_write] - [close ..can_close]))))) + [read] + [read_line] + [write] + [close]))))) (with_expansions [<jvm> (as_is (import: java/lang/String) @@ -92,35 +80,28 @@ exception.return (: (Console IO)) ## TODO: Remove ASAP (implementation - (def: read - (..can_read - (function (_ _) - (|> jvm_input - java/io/InputStream::read - (\ (try.with io.monad) map .nat))))) + (def: (read _) + (|> jvm_input + java/io/InputStream::read + (\ (try.with io.monad) map .nat))) - (def: read_line - (..can_read - (function (_ _) - (java/io/Console::readLine jvm_console)))) + (def: (read_line _) + (java/io/Console::readLine jvm_console)) - (def: write - (..can_write - (function (_ message) - (java/io/PrintStream::print message jvm_output)))) + (def: (write message) + (java/io/PrintStream::print message jvm_output)) (def: close - (..can_close - (|>> (exception.throw ..cannot_close) wrap))))))))))] + (|>> (exception.throw ..cannot_close) wrap)))))))))] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)} (as_is))) (def: #export (write_line message console) (All [!] (-> Text (Console !) (! (Try Any)))) - (!.use (\ console write) [(format message text.new_line)])) + (\ console write (format message text.new_line))) -(interface: #export (Simulation s) +(interface: #export (Mock s) (: (-> s (Try [s Char])) on_read) (: (-> s (Try [s Text])) @@ -130,54 +111,48 @@ (: (-> s (Try s)) on_close)) -(def: #export (mock simulation init) - (All [s] (-> (Simulation s) s (Console IO))) +(def: #export (mock mock init) + (All [s] (-> (Mock s) s (Console IO))) (let [state (atom.atom init)] (`` (implementation - (~~ (template [<method> <simulation>] - [(def: <method> - (..can_read - (function (_ _) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation <simulation> |state|) - (#try.Success [|state| output]) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success output))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))] + (~~ (template [<method> <mock>] + [(def: (<method> _) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock <mock> |state|) + (#try.Success [|state| output]) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success output))) + + (#try.Failure error) + (wrap (#try.Failure error)))))] [read on_read] [read_line on_read_line] )) - (def: write - (..can_write - (function (_ input) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation on_write input |state|) - (#try.Success |state|) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error))))))) - - (def: close - (..can_close - (function (_ _) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation on_close |state|) - (#try.Success |state|) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error))))))) + (def: (write input) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock on_write input |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))) + + (def: (close _) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock on_close |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))) )))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 891d40530..76fb8bc56 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -11,9 +11,7 @@ ["." function] [concurrency ["." promise (#+ Promise)] - ["." stm (#+ Var STM)]] - [security - ["!" capability (#+ capability:)]]] + ["." stm (#+ Var STM)]]] [data ["." bit ("#\." equivalence)] ["." product] @@ -38,27 +36,12 @@ (type: #export Path Text) -(capability: #export (Can_Open ! capability) - (can_open Path (! (Try (capability !))))) - -(capability: #export (Can_See o) - (can_see [] o)) - -(capability: #export (Can_Query ! o) - (can_query [] (! (Try o)))) - -(capability: #export (Can_Modify ! i) - (can_modify [i] (! (Try Any)))) - -(capability: #export (Can_Delete !) - (can_delete [] (! (Try Any)))) - (`` (interface: #export (File !) - (: (Can_See Path) + (: Path path) (~~ (template [<name> <output>] - [(: (Can_Query ! <output>) + [(: (-> [] (! (Try <output>))) <name>)] [size Nat] @@ -67,11 +50,11 @@ [content Binary] )) - (: (Can_Open ! File) + (: (-> Path (! (Try (File !)))) move) (~~ (template [<name> <input>] - [(: (Can_Modify ! <input>) + [(: (-> [<input>] (! (Try Any))) <name>)] [modify Instant] @@ -79,26 +62,26 @@ [append Binary] )) - (: (Can_Delete !) + (: (-> [] (! (Try Any))) delete) )) (interface: #export (Directory !) - (: (Can_See Path) + (: Path scope) - (: (Can_Query ! (List (File !))) + (: (-> [] (! (Try (List (File !))))) files) - (: (Can_Query ! (List (Directory !))) + (: (-> [] (! (Try (List (Directory !))))) directories) - (: (Can_Delete !) + (: (-> [] (! (Try Any))) discard)) (`` (interface: #export (System !) (~~ (template [<name> <capability>] - [(: (Can_Open ! <capability>) + [(: (-> Path (! (Try (<capability> !)))) <name>)] [file File] @@ -123,30 +106,25 @@ (-> (File IO) (File Promise)) (`` (implementation (def: path - (..can_see - (|>> (!.use (\ file path))))) - - (~~ (template [<forge> <name>+] - [(with_expansions [<rows> (template.splice <name>+)] - (template [<name>] - [(def: <name> - (<forge> - (|>> (!.use (\ file <name>)) promise.future)))] - - <rows>))] - - [..can_query - [[size] [last_modified] [can_execute?] [content]]] - - [..can_modify - [[modify] [over_write] [append]]] - - [..can_delete - [[delete]]])) + (\ file path)) + + (~~ (template [<name>] + [(def: <name> + (|>> (\ file <name>) promise.future))] + + [size] + [last_modified] + [can_execute?] + [content] + [modify] + [over_write] + [append] + [delete])) (def: move - (..can_open - (|>> (!.use (\ file move)) (io\map (try\map async_file)) promise.future)))))) + (|>> (\ file move) + (io\map (try\map async_file)) + promise.future))))) (def: (async_directory directory) (-> (Directory IO) (Directory Promise)) @@ -156,24 +134,24 @@ (~~ (template [<name> <async>] [(def: <name> - (..can_query - (|>> (!.use (\ directory <name>)) - (io\map (try\map (list\map <async>))) - promise.future)))] + (|>> (\ directory <name>) + (io\map (try\map (list\map <async>))) + promise.future))] [files ..async_file] [directories async_directory])) (def: discard - (..can_delete - (|>> (!.use (\ directory discard)) promise.future)))))) + (|>> (\ directory discard) promise.future))))) (def: #export (async system) (-> (System IO) (System Promise)) (`` (implementation (~~ (template [<name> <async>] - [(def: <name> (..can_open - (|>> (!.use (\ system <name>)) (io\map (try\map <async>)) promise.future)))] + [(def: <name> + (|>> (\ system <name>) + (io\map (try\map <async>)) + promise.future))] [file ..async_file] [create_file ..async_file] @@ -285,142 +263,116 @@ (-> Path (File IO)) (~~ (template [<name> <flag>] - [(def: <name> - (..can_modify - (function (<name> data) - (do (try.with io.monad) - [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>) - _ (java/io/OutputStream::write data stream) - _ (java/io/OutputStream::flush stream)] - (java/lang/AutoCloseable::close stream)))))] + [(def: (<name> data) + (do (try.with io.monad) + [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>) + _ (java/io/OutputStream::write data stream) + _ (java/io/OutputStream::flush stream)] + (java/lang/AutoCloseable::close stream)))] [over_write #0] [append #1] )) - (def: content - (..can_query - (function (content _) - (do (try.with io.monad) - [#let [file (java/io/File::new path)] - size (java/io/File::length file) - #let [data (binary.create (.nat size))] - stream (java/io/FileInputStream::new file) - bytes_read (java/io/InputStream::read data stream) - _ (java/lang/AutoCloseable::close stream)] - (if (i.= size bytes_read) - (wrap data) - (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))))) + (def: (content _) + (do (try.with io.monad) + [#let [file (java/io/File::new path)] + size (java/io/File::length file) + #let [data (binary.create (.nat size))] + stream (java/io/FileInputStream::new file) + bytes_read (java/io/InputStream::read data stream) + _ (java/lang/AutoCloseable::close stream)] + (if (i.= size bytes_read) + (wrap data) + (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))) (def: path - (..can_see - (function (_ _) - path))) - - (def: size - (..can_query - (function (size _) - (|> path - java/io/File::new - java/io/File::length - (\ (try.with io.monad) map .nat))))) - - (def: last_modified - (..can_query - (function (last_modified _) - (|> path - java/io/File::new - (java/io/File::lastModified) - (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))))) - - (def: can_execute? - (..can_query - (function (can_execute? _) - (|> path - java/io/File::new - java/io/File::canExecute)))) - - (def: move - (..can_open - (function (move destination) - (do io.monad - [outcome (java/io/File::renameTo (java/io/File::new destination) - (java/io/File::new path))] - (case outcome - (#try.Success #1) - (wrap (#try.Success (file destination))) - - _ - (wrap (exception.throw ..cannot_move [destination path]))))))) - - (def: modify - (..can_modify - (function (modify time_stamp) - (do io.monad - [outcome (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis) - (java/io/File::new path))] - (case outcome - (#try.Success #1) - (wrap (#try.Success [])) - - _ - (wrap (exception.throw ..cannot_modify [time_stamp path]))))))) - - (def: delete - (..can_delete - (function (delete _) - (!delete path cannot_delete_file)))))) + path) + + (def: (size _) + (|> path + java/io/File::new + java/io/File::length + (\ (try.with io.monad) map .nat))) + + (def: (last_modified _) + (|> path + java/io/File::new + (java/io/File::lastModified) + (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))) + + (def: (can_execute? _) + (|> path + java/io/File::new + java/io/File::canExecute)) + + (def: (move destination) + (do io.monad + [outcome (java/io/File::renameTo (java/io/File::new destination) + (java/io/File::new path))] + (case outcome + (#try.Success #1) + (wrap (#try.Success (file destination))) + + _ + (wrap (exception.throw ..cannot_move [destination path]))))) + + (def: (modify time_stamp) + (do io.monad + [outcome (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis) + (java/io/File::new path))] + (case outcome + (#try.Success #1) + (wrap (#try.Success [])) + + _ + (wrap (exception.throw ..cannot_modify [time_stamp path]))))) + + (def: (delete _) + (!delete path cannot_delete_file)))) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name> <method> <capability>] - [(def: <name> - (..can_query - (function (<name> _) - (do {! (try.with io.monad)} - [?children (java/io/File::listFiles (java/io/File::new path))] - (case ?children - (#.Some children) - (|> children - array.to_list - (monad.filter ! (|>> <method>)) - (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>)))) - (\ ! join)) - - #.None - (\ io.monad wrap (exception.throw ..not_a_directory [path])))))))] + [(def: (<name> _) + (do {! (try.with io.monad)} + [?children (java/io/File::listFiles (java/io/File::new path))] + (case ?children + (#.Some children) + (|> children + array.to_list + (monad.filter ! (|>> <method>)) + (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>)))) + (\ ! join)) + + #.None + (\ io.monad wrap (exception.throw ..not_a_directory [path])))))] [files java/io/File::isFile file] [directories java/io/File::isDirectory directory] )) - (def: discard - (..can_delete - (function (discard _) - (!delete path cannot_discard_directory)))))) + (def: (discard _) + (!delete path cannot_discard_directory)))) (`` (implementation: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] - [(def: <name> - (..can_open - (function (<name> path) - (do io.monad - [#let [file (java/io/File::new path)] - outcome (<method> file)] - (case outcome - (#try.Success #1) - (wrap (#try.Success (<capability> path))) - - _ - (wrap (exception.throw <exception> [path])))))))] + [(def: (<name> path) + (do io.monad + [#let [file (java/io/File::new path)] + outcome (<method> file)] + (case outcome + (#try.Success #1) + (wrap (#try.Success (<capability> path))) + + _ + (wrap (exception.throw <exception> [path])))))] [file java/io/File::isFile ..file cannot_find_file] [create_file java/io/File::createNewFile ..file cannot_create_file] @@ -507,157 +459,129 @@ (-> Path (File IO)) (~~ (template [<name> <method>] - [(def: <name> - (..can_modify - (function (<name> data) - (<method> [path (Buffer::from data)] (..node_fs [])))))] + [(def: (<name> data) + (<method> [path (Buffer::from data)] (..node_fs [])))] [over_write Fs::writeFileSync] [append Fs::appendFileSync] )) - (def: content - (..can_query - (function (_ _) - (Fs::readFileSync [path] (..node_fs []))))) + (def: (content _) + (Fs::readFileSync [path] (..node_fs []))) (def: path - (..can_see - (function (_ _) - path))) - - (def: size - (..can_query - (function (_ _) - (do (try.with io.monad) - [stat (Fs::statSync [path] (..node_fs []))] - (wrap (|> stat - Stats::size - f.nat)))))) - - (def: last_modified - (..can_query - (function (_ _) - (do (try.with io.monad) - [stat (Fs::statSync [path] (..node_fs []))] - (wrap (|> stat - Stats::mtimeMs - f.int - duration.from_millis - instant.absolute)))))) - - (def: can_execute? - (..can_query - (function (can_execute? _) - (do (try.with io.monad) - [#let [node_fs (..node_fs [])] - _ (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] - (do io.monad - [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)] - (wrap (#try.Success (case outcome - (#try.Success _) - true - - (#try.Failure _) - false)))))))) - - (def: move - (..can_open - (function (move destination) - (do (try.with io.monad) - [_ (Fs::renameSync [path destination] (..node_fs []))] - (wrap (file destination)))))) - - (def: modify - (..can_modify - (function (modify time_stamp) - (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] - (Fs::utimesSync [path when when] (..node_fs [])))))) - - (def: delete - (..can_delete - (function (delete _) - (Fs::unlink [path] (..node_fs []))))))) + path) + + (def: (size _) + (do (try.with io.monad) + [stat (Fs::statSync [path] (..node_fs []))] + (wrap (|> stat + Stats::size + f.nat)))) + + (def: (last_modified _) + (do (try.with io.monad) + [stat (Fs::statSync [path] (..node_fs []))] + (wrap (|> stat + Stats::mtimeMs + f.int + duration.from_millis + instant.absolute)))) + + (def: (can_execute? _) + (do (try.with io.monad) + [#let [node_fs (..node_fs [])] + _ (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] + (do io.monad + [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)] + (wrap (#try.Success (case outcome + (#try.Success _) + true + + (#try.Failure _) + false)))))) + + (def: (move destination) + (do (try.with io.monad) + [_ (Fs::renameSync [path destination] (..node_fs []))] + (wrap (file destination)))) + + (def: (modify time_stamp) + (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] + (Fs::utimesSync [path when when] (..node_fs [])))) + + (def: (delete _) + (Fs::unlink [path] (..node_fs []))))) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name> <method> <capability>] - [(def: <name> - (..can_query - (function (<name> _) - (do {! (try.with io.monad)} - [#let [node_fs (..node_fs [])] - subs (Fs::readdirSync [path] node_fs) - subs (monad.map ! (function (_ sub) - (do ! - [stats (Fs::statSync [sub] node_fs) - verdict (<method> [] stats)] - (wrap [verdict sub]))) - (array.to_list subs))] - (wrap (|> subs - (list.filter product.left) - (list\map (|>> product.right <capability>))))))))] + [(def: (<name> _) + (do {! (try.with io.monad)} + [#let [node_fs (..node_fs [])] + subs (Fs::readdirSync [path] node_fs) + subs (monad.map ! (function (_ sub) + (do ! + [stats (Fs::statSync [sub] node_fs) + verdict (<method> [] stats)] + (wrap [verdict sub]))) + (array.to_list subs))] + (wrap (|> subs + (list.filter product.left) + (list\map (|>> product.right <capability>))))))] [files Stats::isFile ..file] [directories Stats::isDirectory directory] )) - (def: discard - (..can_delete - (function (discard _) - (Fs::rmdirSync [path] (..node_fs []))))))) + (def: (discard _) + (Fs::rmdirSync [path] (..node_fs []))))) (`` (implementation: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] [(with_expansions [<failure> (exception.throw <exception> [path])] - (def: <name> - (..can_open - (function (<name> path) - (do {! io.monad} - [?stats (Fs::statSync [path] (..node_fs []))] - (case ?stats - (#try.Success stats) - (do ! - [?verdict (<method> [] stats)] - (wrap (case ?verdict - (#try.Success verdict) - (if verdict - (#try.Success (<capability> path)) - <failure>) - - (#try.Failure _) - <failure>))) - - (#try.Failure _) - (wrap <failure>)))))))] + (def: (<name> path) + (do {! io.monad} + [?stats (Fs::statSync [path] (..node_fs []))] + (case ?stats + (#try.Success stats) + (do ! + [?verdict (<method> [] stats)] + (wrap (case ?verdict + (#try.Success verdict) + (if verdict + (#try.Success (<capability> path)) + <failure>) + + (#try.Failure _) + <failure>))) + + (#try.Failure _) + (wrap <failure>)))))] [file Stats::isFile ..file ..cannot_find_file] [directory Stats::isDirectory ..directory ..cannot_find_directory] )) (~~ (template [<name> <capability> <exception> <prep>] - [(def: <name> - (..can_open - (function (<name> path) - (let [node_fs (..node_fs [])] - (do io.monad - [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] - (case outcome - (#try.Success _) - (wrap (exception.throw <exception> [path])) - - (#try.Failure _) - (do (try.with io.monad) - [_ (|> node_fs <prep>)] - (wrap (<capability> path)))))))))] + [(def: (<name> path) + (let [node_fs (..node_fs [])] + (do io.monad + [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] + (case outcome + (#try.Success _) + (wrap (exception.throw <exception> [path])) + + (#try.Failure _) + (do (try.with io.monad) + [_ (|> node_fs <prep>)] + (wrap (<capability> path)))))))] [create_file ..file ..cannot_create_file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])] [create_directory ..directory ..cannot_create_directory (Fs::mkdirSync [path])] @@ -710,106 +634,82 @@ (-> Path (File IO)) (~~ (template [<name> <mode>] - [(def: <name> - (..can_modify - (function (<name> data) - (do (try.with io.monad) - [file (..open [path <mode>]) - _ (PyFile::write [data] file) - _ (PyFile::close [] file)] - (wrap [])))))] + [(def: (<name> data) + (do (try.with io.monad) + [file (..open [path <mode>]) + _ (PyFile::write [data] file) + _ (PyFile::close [] file)] + (wrap [])))] [over_write "w+b"] [append "ab"] )) - (def: content - (..can_query - (function (_ _) - (do (try.with io.monad) - [file (..open [path "rb"]) - data (PyFile::read [] file) - _ (PyFile::close [] file)] - (wrap data))))) + (def: (content _) + (do (try.with io.monad) + [file (..open [path "rb"]) + data (PyFile::read [] file) + _ (PyFile::close [] file)] + (wrap data))) (def: path - (..can_see - (function (_ _) - path))) - - (def: size - (..can_query - (function (_ _) - (do (try.with io.monad) - [size (os/path::getsize [path])] - (wrap (.nat size)))))) - - (def: last_modified - (..can_query - (function (_ _) - (do (try.with io.monad) - [seconds_since_epoch (os/path::getmtime [path])] - (wrap (|> seconds_since_epoch - f.int - (i.* +1,000) - duration.from_millis - instant.absolute)))))) - - (def: can_execute? - (..can_query - (function (can_execute? _) - (os::access [path (os::X_OK)])))) - - (def: move - (..can_open - (function (move destination) - (do (try.with io.monad) - [_ (os::rename [path destination])] - (wrap (file destination)))))) - - (def: modify - (..can_modify - (function (modify time_stamp) - (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))] - (os::utime [path (..tuple [when when])]))))) - - (def: delete - (..can_delete - (function (delete _) - (os::remove [path])))) + path) + + (def: (size _) + (do (try.with io.monad) + [size (os/path::getsize [path])] + (wrap (.nat size)))) + + (def: (last_modified _) + (do (try.with io.monad) + [seconds_since_epoch (os/path::getmtime [path])] + (wrap (|> seconds_since_epoch + f.int + (i.* +1,000) + duration.from_millis + instant.absolute)))) + + (def: (can_execute? _) + (os::access [path (os::X_OK)])) + + (def: (move destination) + (do (try.with io.monad) + [_ (os::rename [path destination])] + (wrap (file destination)))) + + (def: (modify time_stamp) + (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))] + (os::utime [path (..tuple [when when])]))) + + (def: (delete _) + (os::remove [path])) )) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name> <method> <capability>] - [(def: <name> - (..can_query - (function (<name> _) - (do {! (try.with io.monad)} - [subs (os::listdir [path]) - subs (monad.map ! (function (_ sub) - (do ! - [verdict (<method> [sub])] - (wrap [verdict sub]))) - (array.to_list subs))] - (wrap (|> subs - (list.filter product.left) - (list\map (|>> product.right <capability>))))))))] + [(def: (<name> _) + (do {! (try.with io.monad)} + [subs (os::listdir [path]) + subs (monad.map ! (function (_ sub) + (do ! + [verdict (<method> [sub])] + (wrap [verdict sub]))) + (array.to_list subs))] + (wrap (|> subs + (list.filter product.left) + (list\map (|>> product.right <capability>))))))] [files os/path::isfile ..file] [directories os/path::isdir directory] )) - (def: discard - (..can_delete - (function (discard _) - (os::rmdir [path])))) + (def: (discard _) + (os::rmdir [path])) )) (`` (implementation: #export default @@ -817,49 +717,43 @@ (~~ (template [<name> <method> <capability> <exception>] [(with_expansions [<failure> (exception.throw <exception> [path])] - (def: <name> - (..can_open - (function (<name> path) - (do io.monad - [?verdict (<method> [path])] - (wrap (case ?verdict - (#try.Success verdict) - (if verdict - (#try.Success (<capability> path)) - <failure>) - - (#try.Failure _) - <failure>)))))))] + (def: (<name> path) + (do io.monad + [?verdict (<method> [path])] + (wrap (case ?verdict + (#try.Success verdict) + (if verdict + (#try.Success (<capability> path)) + <failure>) + + (#try.Failure _) + <failure>)))))] [file os/path::isfile ..file ..cannot_find_file] [directory os/path::isdir ..directory ..cannot_find_directory] )) - (def: create_file - (..can_open - (function (create_file path) - (do {! io.monad} - [file (..open [path "w"])] - (case file - (#try.Success file) - (do (try.with !) - [_ (PyFile::close [] file)] - (wrap (..file path))) - - (#try.Failure error) - (wrap (exception.throw ..cannot_create_file [path]))))))) - - (def: create_directory - (..can_open - (function (create_directory path) - (do io.monad - [outcome (os::mkdir [path])] - (wrap (case outcome - (#try.Success _) - (#try.Success (..directory path)) - - (#try.Failure error) - (exception.throw ..cannot_create_directory [path]))))))) + (def: (create_file path) + (do {! io.monad} + [file (..open [path "w"])] + (case file + (#try.Success file) + (do (try.with !) + [_ (PyFile::close [] file)] + (wrap (..file path))) + + (#try.Failure error) + (wrap (exception.throw ..cannot_create_file [path]))))) + + (def: (create_directory path) + (do io.monad + [outcome (os::mkdir [path])] + (wrap (case outcome + (#try.Success _) + (#try.Success (..directory path)) + + (#try.Failure error) + (exception.throw ..cannot_create_directory [path]))))) (def: separator (os/path::sep)) @@ -910,136 +804,118 @@ (-> Path (File IO)) (~~ (template [<name> <mode>] - [(def: <name> - (..can_modify - (function (<name> data) - (do {! io.monad} - [?file (io/open [path <mode>])] - (case ?file - (#.Some file) - (do ! - [?wrote (LuaFile::write [("lua utf8 decode" data)] file)] - (case ?wrote - (#.Some _) - (do ! - [flushed? (LuaFile::flush [] file) - closed? (LuaFile::close [] file)] - (wrap (cond (not flushed?) - (exception.throw ..cannot_write_to_file [path]) - - (not closed?) - (exception.throw ..cannot_close_file [path]) - - ## else - (#try.Success [])))) - - #.None - (wrap (exception.throw ..cannot_write_to_file [path])))) - - #.None - (wrap (exception.throw ..cannot_open_file [path])))))))] + [(def: (<name> data) + (do {! io.monad} + [?file (io/open [path <mode>])] + (case ?file + (#.Some file) + (do ! + [?wrote (LuaFile::write [("lua utf8 decode" data)] file)] + (case ?wrote + (#.Some _) + (do ! + [flushed? (LuaFile::flush [] file) + closed? (LuaFile::close [] file)] + (wrap (cond (not flushed?) + (exception.throw ..cannot_write_to_file [path]) + + (not closed?) + (exception.throw ..cannot_close_file [path]) + + ## else + (#try.Success [])))) + + #.None + (wrap (exception.throw ..cannot_write_to_file [path])))) + + #.None + (wrap (exception.throw ..cannot_open_file [path])))))] [over_write "w+b"] [append "ab"] )) - (def: content - (..can_query - (function (_ _) - (do {! io.monad} - [?file (io/open [path "rb"])] - (case ?file - (#.Some file) - (do ! - [data (LuaFile::read ["a"] file) - closed? (LuaFile::close [] file)] - (wrap (if closed? - (#try.Success ("lua utf8 encode" data)) - (exception.throw ..cannot_close_file [path])))) - - #.None - (wrap (exception.throw ..cannot_read_all_data [path]))))))) + (def: (content _) + (do {! io.monad} + [?file (io/open [path "rb"])] + (case ?file + (#.Some file) + (do ! + [data (LuaFile::read ["a"] file) + closed? (LuaFile::close [] file)] + (wrap (if closed? + (#try.Success ("lua utf8 encode" data)) + (exception.throw ..cannot_close_file [path])))) + + #.None + (wrap (exception.throw ..cannot_read_all_data [path]))))) (def: path - (..can_see - (function (_ _) - path))) - - (~~ (template [<capability> <name>] - [(def: <name> - (<capability> - (function (_ _) - (let [[_ short] (name_of <name>)] - (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))] - - [..can_query size] - [..can_query last_modified] - [..can_query can_execute?] - - [..can_modify modify] + path) + + (~~ (template [<name>] + [(def: (<name> _) + (let [[_ short] (name_of <name>)] + (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))] + + [size] + [last_modified] + [can_execute?] + + [modify] )) - (def: move - (..can_open - (function (move destination) - (do io.monad - [?verdict (os/rename [path destination])] - (wrap (if (case ?verdict - (#.Some verdict) - verdict - - #.None - false) - (#try.Success (file destination)) - (exception.throw ..cannot_move [destination path]))))))) - - (def: delete - (..can_delete - (function (delete _) - (do io.monad - [?verdict (os/remove [path])] - (wrap (if (case ?verdict - (#.Some verdict) - verdict - - #.None - false) - (#try.Success []) - (exception.throw ..cannot_delete_file path))))))) + (def: (move destination) + (do io.monad + [?verdict (os/rename [path destination])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success (file destination)) + (exception.throw ..cannot_move [destination path]))))) + + (def: (delete _) + (do io.monad + [?verdict (os/remove [path])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success []) + (exception.throw ..cannot_delete_file path))))) )) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name>] - [(def: <name> - (..can_query - (function (_ _) - (let [[_ short] (name_of <name>)] - (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))))] + [(def: (<name> _) + (let [[_ short] (name_of <name>)] + (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))] [files] [directories] )) - (def: discard - (..can_delete - (function (discard _) - (do io.monad - [?verdict (os/remove [path])] - (wrap (if (case ?verdict - (#.Some verdict) - verdict - - #.None - false) - (#try.Success []) - (exception.throw ..cannot_discard_directory path))))))) + (def: (discard _) + (do io.monad + [?verdict (os/remove [path])] + (wrap (if (case ?verdict + (#.Some verdict) + verdict + + #.None + false) + (#try.Success []) + (exception.throw ..cannot_discard_directory path))))) )) (def: (default_file path) @@ -1082,37 +958,33 @@ (`` (implementation: #export default (System IO) - (def: file (..can_open ..default_file)) - (def: create_file (..can_open ..default_create_file)) - - (def: directory - (let [dummy "lux_lua_dummy_file"] - (..can_open - (function (directory path) - (do {! io.monad} - [?file (..default_create_file (format path ..default_separator dummy))] - (case ?file - (#try.Success file) - (do (try.with !) - [_ (!.use (\ file delete) [])] - (wrap (..directory path))) - - (#try.Failure error) - (wrap (if (exception.match? ..file_already_exists error) - (#try.Success (..directory path)) - (exception.throw ..cannot_find_directory [path]))))))))) - - (def: create_directory - (..can_open - (function (create_directory path) - (do io.monad - [?verdict (os/execute [(format "mkdir " path)])] - (wrap (case ?verdict - (#.Some verdict) - (#try.Success (..directory path)) - - #.None - (exception.throw ..cannot_create_directory [path]))))))) + (def: file ..default_file) + (def: create_file ..default_create_file) + + (def: (directory path) + (do {! io.monad} + [#let [dummy "lux_lua_dummy_file"] + ?file (..default_create_file (format path ..default_separator dummy))] + (case ?file + (#try.Success file) + (do (try.with !) + [_ (\ file delete [])] + (wrap (..directory path))) + + (#try.Failure error) + (wrap (if (exception.match? ..file_already_exists error) + (#try.Success (..directory path)) + (exception.throw ..cannot_find_directory [path])))))) + + (def: (create_directory path) + (do io.monad + [?verdict (os/execute [(format "mkdir " path)])] + (wrap (case ?verdict + (#.Some verdict) + (#try.Success (..directory path)) + + #.None + (exception.throw ..cannot_create_directory [path]))))) (def: separator ..default_separator) @@ -1168,157 +1040,131 @@ (-> Path (File IO)) (~~ (template [<name> <mode>] - [(def: <name> - (..can_modify - (function (<name> data) - (do {! (try.with io.monad)} - [file (RubyFile::open [path <mode>]) - data (RubyFile::write [data] file) - _ (RubyFile::flush [] file) - _ (RubyFile::close [] file)] - (wrap [])))))] + [(def: (<name> data) + (do {! (try.with io.monad)} + [file (RubyFile::open [path <mode>]) + data (RubyFile::write [data] file) + _ (RubyFile::flush [] file) + _ (RubyFile::close [] file)] + (wrap [])))] [over_write "wb"] [append "ab"] )) - (def: content - (..can_query - (function (_ _) - (do {! (try.with io.monad)} - [file (RubyFile::open [path "rb"]) - data (RubyFile::read [] file) - _ (RubyFile::close [] file)] - (wrap data))))) + (def: (content _) + (do {! (try.with io.monad)} + [file (RubyFile::open [path "rb"]) + data (RubyFile::read [] file) + _ (RubyFile::close [] file)] + (wrap data))) (def: path - (..can_see - (function (_ _) - path))) - - (~~ (template [<capability> <name> <pipeline>] - [(def: <name> - (<capability> - (function (_ _) - (do {! (try.with io.monad)} - [stat (: (IO (Try RubyStat)) - (RubyFile::stat [path]))] - (wrap (`` (|> stat (: RubyStat) (~~ (template.splice <pipeline>)))))))))] - - [..can_query size [RubyStat::size .nat]] - [..can_query last_modified [(RubyStat::mtime []) - (RubyTime::to_f []) - (f.* +1,000.0) - f.int - duration.from_millis - instant.absolute]] - [..can_query can_execute? [(RubyStat::executable? [])]] + path) + + (~~ (template [<name> <pipeline>] + [(def: (<name> _) + (do {! (try.with io.monad)} + [stat (: (IO (Try RubyStat)) + (RubyFile::stat [path]))] + (wrap (`` (|> stat (: RubyStat) (~~ (template.splice <pipeline>)))))))] + + [size [RubyStat::size .nat]] + [last_modified [(RubyStat::mtime []) + (RubyTime::to_f []) + (f.* +1,000.0) + f.int + duration.from_millis + instant.absolute]] + [can_execute? [(RubyStat::executable? [])]] )) - (def: modify - (..can_modify - (function (_ moment) - (let [moment (|> moment - instant.relative - duration.to_millis - i.frac - (f./ +1,000.0) - RubyTime::at)] - (do {! (try.with io.monad)} - [_ (RubyFile::utime [moment moment path])] - (wrap [])))))) - - (def: move - (..can_open - (function (_ destination) - (do {! (try.with io.monad)} - [_ (RubyFileUtils::move [path destination])] - (wrap (file destination)))))) - - (def: delete - (..can_delete - (function (_ _) - (do {! (try.with io.monad)} - [_ (RubyFile::delete [path])] - (wrap []))))) + (def: (modify moment) + (let [moment (|> moment + instant.relative + duration.to_millis + i.frac + (f./ +1,000.0) + RubyTime::at)] + (do (try.with io.monad) + [_ (RubyFile::utime [moment moment path])] + (wrap [])))) + + (def: (move destination) + (do (try.with io.monad) + [_ (RubyFileUtils::move [path destination])] + (wrap (file destination)))) + + (def: (delete _) + (do (try.with io.monad) + [_ (RubyFile::delete [path])] + (wrap []))) )) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name> <test> <constructor> <capability>] - [(def: <name> - (..can_query - (function (_ _) - (do {! (try.with io.monad)} - [self (RubyDir::open [path]) - children (RubyDir::children [] self) - output (loop [input (|> children - array.to_list - (list\map (|>> (format path ..default_separator)))) - output (: (List (<capability> IO)) - (list))] - (case input - #.Nil - (wrap output) - - (#.Cons head tail) - (do ! - [verdict (<test> head)] - (if verdict - (recur tail (#.Cons (<constructor> head) output)) - (recur tail output))))) - _ (RubyDir::close [] self)] - (wrap output)))))] + [(def: (<name> _) + (do {! (try.with io.monad)} + [self (RubyDir::open [path]) + children (RubyDir::children [] self) + output (loop [input (|> children + array.to_list + (list\map (|>> (format path ..default_separator)))) + output (: (List (<capability> IO)) + (list))] + (case input + #.Nil + (wrap output) + + (#.Cons head tail) + (do ! + [verdict (<test> head)] + (if verdict + (recur tail (#.Cons (<constructor> head) output)) + (recur tail output))))) + _ (RubyDir::close [] self)] + (wrap output)))] [files RubyFile::file? ..file File] [directories RubyFile::directory? directory Directory] )) - (def: discard - (..can_delete - (function (discard _) - (do {! (try.with io.monad)} - [_ (RubyFileUtils::rmdir [path])] - (wrap []))))) + (def: (discard _) + (do (try.with io.monad) + [_ (RubyFileUtils::rmdir [path])] + (wrap []))) )) (`` (implementation: #export default (System IO) (~~ (template [<name> <test> <constructor> <exception>] - [(def: <name> - (..can_open - (function (_ path) - (do {! (try.with io.monad)} - [verdict (<test> path)] - (\ io.monad wrap - (if verdict - (#try.Success (<constructor> path)) - (exception.throw <exception> [path])))))))] + [(def: (<name> path) + (do {! (try.with io.monad)} + [verdict (<test> path)] + (\ io.monad wrap + (if verdict + (#try.Success (<constructor> path)) + (exception.throw <exception> [path])))))] [file RubyFile::file? ..file ..cannot_find_file] [directory RubyFile::directory? ..directory ..cannot_find_directory] )) - (def: create_file - (..can_open - (function (_ path) - (do {! (try.with io.monad)} - [_ (RubyFileUtils::touch [path])] - (wrap (..file path)))))) - - (def: create_directory - (..can_open - (function (create_directory path) - (do {! (try.with io.monad)} - [_ (RubyFileUtils::mkdir path)] - (wrap (..directory path)))))) + (def: (create_file path) + (do {! (try.with io.monad)} + [_ (RubyFileUtils::touch [path])] + (wrap (..file path)))) + + (def: (create_directory path) + (do {! (try.with io.monad)} + [_ (RubyFileUtils::mkdir path)] + (wrap (..directory path)))) (def: separator ..default_separator) @@ -1370,163 +1216,135 @@ (-> Path (File IO)) (~~ (template [<name> <mode>] - [(def: <name> - (..can_modify - (function (<name> data) - (do {! (try.with io.monad)} - [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] - (if (bit\= false (:coerce Bit outcome)) - (\ io.monad wrap (exception.throw ..cannot_write_to_file [path])) - (wrap []))))))] + [(def: (<name> data) + (do {! (try.with io.monad)} + [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] + (if (bit\= false (:coerce Bit outcome)) + (\ io.monad wrap (exception.throw ..cannot_write_to_file [path])) + (wrap []))))] [over_write +0] [append (..FILE_APPEND)] )) - (def: content - (..can_query - (function (_ _) - (do {! (try.with io.monad)} - [data (..file_get_contents [path])] - (if (bit\= false (:coerce Bit data)) - (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - (wrap (..unpack [..byte_array_format data]))))))) + (def: (content _) + (do {! (try.with io.monad)} + [data (..file_get_contents [path])] + (if (bit\= false (:coerce Bit data)) + (\ io.monad wrap (exception.throw ..cannot_find_file [path])) + (wrap (..unpack [..byte_array_format data]))))) (def: path - (..can_see - (function (_ _) - path))) - - (~~ (template [<capability> <name> <ffi> <pipeline>] - [(def: <name> - (<capability> - (function (_ _) - (do {! (try.with io.monad)} - [value (<ffi> [path])] - (if (bit\= false (:coerce Bit value)) - (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))))] - - [..can_query size ..filesize [.nat]] - [..can_query last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]] + path) + + (~~ (template [<name> <ffi> <pipeline>] + [(def: (<name> _) + (do {! (try.with io.monad)} + [value (<ffi> [path])] + (if (bit\= false (:coerce Bit value)) + (\ io.monad wrap (exception.throw ..cannot_find_file [path])) + (wrap (`` (|> value (~~ (template.splice <pipeline>))))))))] + + [size ..filesize [.nat]] + [last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]] )) - (def: can_execute? - (..can_query - (function (_ _) - (..is_executable [path])))) - - (def: modify - (..can_modify - (function (_ moment) - (do {! (try.with io.monad)} - [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])] - (if (bit\= false (:coerce Bit verdict)) - (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - (wrap [])))))) - - (def: move - (..can_open - (function (_ destination) - (do {! (try.with io.monad)} - [verdict (..rename [path destination])] - (if (bit\= false (:coerce Bit verdict)) - (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - (wrap (file destination))))))) - - (def: delete - (..can_delete - (function (_ _) - (do {! (try.with io.monad)} - [verdict (..unlink [path])] - (if (bit\= false (:coerce Bit verdict)) - (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - (wrap [])))))) + (def: (can_execute? _) + (..is_executable [path])) + + (def: (modify moment) + (do {! (try.with io.monad)} + [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])] + (if (bit\= false (:coerce Bit verdict)) + (\ io.monad wrap (exception.throw ..cannot_find_file [path])) + (wrap [])))) + + (def: (move destination) + (do {! (try.with io.monad)} + [verdict (..rename [path destination])] + (if (bit\= false (:coerce Bit verdict)) + (\ io.monad wrap (exception.throw ..cannot_find_file [path])) + (wrap (file destination))))) + + (def: (delete _) + (do (try.with io.monad) + [verdict (..unlink [path])] + (if (bit\= false (:coerce Bit verdict)) + (\ io.monad wrap (exception.throw ..cannot_find_file [path])) + (wrap [])))) )) (`` (implementation: (directory path) (-> Path (Directory IO)) (def: scope - (..can_see - (function (_ _) - path))) + path) (~~ (template [<name> <test> <constructor> <capability>] - [(def: <name> - (..can_query - (function (_ _) - (do {! (try.with io.monad)} - [children (..scandir [path])] - (loop [input (|> children - array.to_list - (list.filter (function (_ child) - (not (or (text\= "." child) - (text\= ".." child)))))) - output (: (List (<capability> IO)) - (list))] - (case input - #.Nil - (wrap output) - - (#.Cons head tail) - (do ! - [verdict (<test> head)] - (if verdict - (recur tail (#.Cons (<constructor> head) output)) - (recur tail output)))))))))] + [(def: (<name> _) + (do {! (try.with io.monad)} + [children (..scandir [path])] + (loop [input (|> children + array.to_list + (list.filter (function (_ child) + (not (or (text\= "." child) + (text\= ".." child)))))) + output (: (List (<capability> IO)) + (list))] + (case input + #.Nil + (wrap output) + + (#.Cons head tail) + (do ! + [verdict (<test> head)] + (if verdict + (recur tail (#.Cons (<constructor> head) output)) + (recur tail output)))))))] [files ..is_file ..file File] [directories ..is_dir directory Directory] )) - (def: discard - (..can_delete - (function (_ _) - (do {! (try.with io.monad)} - [verdict (..rmdir [path])] - (if (bit\= false (:coerce Bit verdict)) - (\ io.monad wrap (exception.throw ..cannot_find_directory [path])) - (wrap [])))))) + (def: (discard _) + (do (try.with io.monad) + [verdict (..rmdir [path])] + (if (bit\= false (:coerce Bit verdict)) + (\ io.monad wrap (exception.throw ..cannot_find_directory [path])) + (wrap [])))) )) (`` (implementation: #export default (System IO) (~~ (template [<name> <test> <constructor> <exception>] - [(def: <name> - (..can_open - (function (_ path) - (do {! (try.with io.monad)} - [verdict (<test> path)] - (\ io.monad wrap - (if verdict - (#try.Success (<constructor> path)) - (exception.throw <exception> [path])))))))] + [(def: (<name> path) + (do {! (try.with io.monad)} + [verdict (<test> path)] + (\ io.monad wrap + (if verdict + (#try.Success (<constructor> path)) + (exception.throw <exception> [path])))))] [file ..is_file ..file ..cannot_find_file] [directory ..is_dir ..directory ..cannot_find_directory] )) - (def: create_file - (..can_open - (function (_ path) - (do {! (try.with io.monad)} - [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])] - (\ io.monad wrap - (if verdict - (#try.Success (..file path)) - (exception.throw ..cannot_create_file [path]))))))) + (def: (create_file path) + (do {! (try.with io.monad)} + [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])] + (\ io.monad wrap + (if verdict + (#try.Success (..file path)) + (exception.throw ..cannot_create_file [path]))))) - (def: create_directory - (..can_open - (function (_ path) - (do {! (try.with io.monad)} - [verdict (..mkdir path)] - (\ io.monad wrap - (if verdict - (#try.Success (..directory path)) - (exception.throw ..cannot_create_directory [path]))))))) + (def: (create_directory path) + (do {! (try.with io.monad)} + [verdict (..mkdir path)] + (\ io.monad wrap + (if verdict + (#try.Success (..directory path)) + (exception.throw ..cannot_create_directory [path]))))) (def: separator ..default_separator) @@ -1541,14 +1359,14 @@ [(def: #export (<get> monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try (<signature> !))))) (do monad - [outcome (!.use (\ system <find>) path)] + [outcome (\ system <find> path)] (case outcome (#try.Success file) (wrap (#try.Success file)) (#try.Failure error) (if (exception.match? <exception> error) - (!.use (\ system <create>) path) + (\ system <create> path) (wrap (#try.Failure error))))))] [get_file File create_file file ..cannot_find_file] @@ -1559,7 +1377,7 @@ [(def: #export (<predicate> monad system path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [?file (!.use (\ system <capability>) path)] + [?file (\ system <capability> path)] (case ?file (#try.Success file) (wrap true) @@ -1720,108 +1538,89 @@ (-> Text Path (Var Mock) (File Promise)) (implementation (def: path - (..can_see - (function.constant path))) + path) - (def: size - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (binary.size (get@ #mock_content file)))))))))) - - (def: content - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (get@ #mock_content file))))))))) - - (def: last_modified - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (get@ #mock_last_modified file))))))))) - - (def: can_execute? - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (get@ #mock_can_execute file))))))))) - - (def: over_write - (..can_modify - (function (_ content) - (do promise.monad - [now (promise.future instant.now)] - (stm.commit - (..try_update! (..update_mock_file! separator path now content) store)))))) - - (def: append - (..can_modify - (function (_ content) - (do promise.monad - [now (promise.future instant.now)] - (stm.commit - (..try_update! (function (_ |store|) - (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (..update_mock_file! separator path now - (\ binary.monoid compose - (get@ #mock_content file) - content) - |store|))) - store)))))) - - (def: modify - (..can_modify - (function (_ now) - (stm.commit - (..try_update! (function (_ |store|) - (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (..update_mock_file! separator path now (get@ #mock_content file) |store|))) - store))))) - - (def: delete - (..can_delete - (function (_ _) - (stm.commit - (..try_update! (..delete_mock_file! separator path) store))))) - - (def: move - (..can_open - (function (_ path) - (stm.commit - (do {! stm.monad} - [|store| (stm.read store)] - (case (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|) - |store| (..delete_mock_file! separator path |store|) - [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|) - |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)] - (wrap [|store| (mock_file separator path store)])) - (#try.Success [|store| moved]) - (do ! - [_ (stm.write |store| store)] - (wrap (#try.Success moved))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + (def: (size _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (binary.size (get@ #mock_content file)))))))) + + (def: (content _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_content file))))))) + + (def: (last_modified _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_last_modified file))))))) + + (def: (can_execute? _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_can_execute file))))))) + + (def: (over_write content) + (do promise.monad + [now (promise.future instant.now)] + (stm.commit + (..try_update! (..update_mock_file! separator path now content) store)))) + + (def: (append content) + (do promise.monad + [now (promise.future instant.now)] + (stm.commit + (..try_update! (function (_ |store|) + (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now + (\ binary.monoid compose + (get@ #mock_content file) + content) + |store|))) + store)))) + + (def: (modify now) + (stm.commit + (..try_update! (function (_ |store|) + (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (get@ #mock_content file) |store|))) + store))) + + (def: (delete _) + (stm.commit + (..try_update! (..delete_mock_file! separator path) store))) + + (def: (move path) + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|) + |store| (..delete_mock_file! separator path |store|) + [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|) + |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)] + (wrap [|store| (mock_file separator path store)])) + (#try.Success [|store| moved]) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success moved))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) )) (def: (create_mock_directory! separator path mock) @@ -1908,64 +1707,56 @@ (-> Text Path (Var Mock) (Directory Promise)) (implementation (def: scope - (..can_see - (function (_ _) - path))) + path) - (def: files - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [directory (..retrieve_mock_directory! separator path |store|)] - (wrap (|> directory - dictionary.entries - (list.all (function (_ [node_name node]) - (case node - (#.Left file) - (#.Some (..mock_file separator + (def: (files _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [directory (..retrieve_mock_directory! separator path |store|)] + (wrap (|> directory + dictionary.entries + (list.all (function (_ [node_name node]) + (case node + (#.Left file) + (#.Some (..mock_file separator + (format path separator node_name) + store)) + + (#.Right directory) + #.None)))))))))) + + (def: (directories _) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [directory (..retrieve_mock_directory! separator path |store|)] + (wrap (|> directory + dictionary.entries + (list.all (function (_ [node_name node]) + (case node + (#.Left file) + #.None + + (#.Right directory) + (#.Some (mock_directory separator (format path separator node_name) - store)) - - (#.Right directory) - #.None)))))))))))) - - (def: directories - (..can_query - (function (_ _) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [directory (..retrieve_mock_directory! separator path |store|)] - (wrap (|> directory - dictionary.entries - (list.all (function (_ [node_name node]) - (case node - (#.Left file) - #.None - - (#.Right directory) - (#.Some (mock_directory separator - (format path separator node_name) - store)))))))))))))) - - (def: discard - (..can_delete - (function (_ _) - (stm.commit - (do {! stm.monad} - [|store| (stm.read store)] - (case (..delete_mock_directory! separator path |store|) - (#try.Success |store|) - (do ! - [_ (stm.write |store| store)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + store)))))))))))) + + (def: (discard _) + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (..delete_mock_directory! separator path |store|) + (#try.Success |store|) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) )) (def: #export (mock separator) @@ -1974,57 +1765,49 @@ (implementation (def: separator separator) - (def: file - (..can_open - (function (_ path) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [[name file] (..retrieve_mock_file! separator path |store|)] - (wrap (..mock_file separator path store))))))))) - - (def: create_file - (..can_open - (function (_ path) - (do promise.monad - [now (promise.future instant.now)] - (stm.commit - (do {! stm.monad} - [|store| (stm.read store)] - (case (..create_mock_file! separator path now |store|) - (#try.Success [name |store|]) - (do ! - [_ (stm.write |store| store)] - (wrap (#try.Success (..mock_file separator path store)))) - - (#try.Failure error) - (wrap (#try.Failure error))))))))) - - (def: directory - (..can_open - (function (_ path) - (stm.commit - (do stm.monad - [|store| (stm.read store)] - (wrap (do try.monad - [directory (..retrieve_mock_directory! separator path |store|)] - (wrap (..mock_directory separator path store))))))))) - - (def: create_directory - (..can_open - (function (_ path) - (stm.commit - (do {! stm.monad} - [|store| (stm.read store)] - (case (..create_mock_directory! separator path |store|) - (#try.Success |store|) - (do ! - [_ (stm.write |store| store)] - (wrap (#try.Success (..mock_directory separator path store)))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) + (def: (file path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (..mock_file separator path store))))))) + + (def: (create_file path) + (do promise.monad + [now (promise.future instant.now)] + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (..create_mock_file! separator path now |store|) + (#try.Success [name |store|]) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success (..mock_file separator path store)))) + + (#try.Failure error) + (wrap (#try.Failure error))))))) + + (def: (directory path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (do try.monad + [directory (..retrieve_mock_directory! separator path |store|)] + (wrap (..mock_directory separator path store))))))) + + (def: (create_directory path) + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (..create_mock_directory! separator path |store|) + (#try.Success |store|) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success (..mock_directory separator path store)))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) ))) (def: #export (make_directories monad system path) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 24d8657ad..85ae21b2f 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -11,9 +11,7 @@ ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise)] - ["." stm (#+ STM Var)]] - [security - ["!" capability]]] + ["." stm (#+ STM Var)]]] [data ["." product] ["." maybe] @@ -117,12 +115,12 @@ (def: (file_tracker fs directory) (-> (//.System Promise) (//.Directory Promise) (Promise (Try File_Tracker))) (do {! (try.with promise.monad)} - [files (!.use (\ directory files) [])] + [files (\ directory files [])] (monad.fold ! (function (_ file tracker) (do ! - [last_modified (!.use (\ file last_modified) [])] - (wrap (dictionary.put (!.use (\ file path) []) + [last_modified (\ file last_modified [])] + (wrap (dictionary.put (\ file path) [file last_modified] tracker)))) (: File_Tracker @@ -132,11 +130,11 @@ (def: (poll_files directory file_tracker) (-> (//.Directory Promise) File_Tracker (Promise (Try (List [//.Path (//.File Promise) Instant])))) (do {! (try.with promise.monad)} - [files (!.use (\ directory files) [])] + [files (\ directory files [])] (monad.map ! (function (_ file) (do ! - [last_modified (!.use (\ file last_modified) [])] - (wrap [(!.use (\ file path) []) file last_modified]))) + [last_modified (\ file last_modified [])] + (wrap [(\ file path) file last_modified]))) files))) (def: (poll_directory_changes [path [concern directory file_tracker]]) @@ -195,7 +193,7 @@ (if updated? (wrap (#try.Success [])) (do (try.with !) - [directory (!.use (\ fs directory) path) + [directory (\ fs directory path) file_tracker (..file_tracker fs directory)] (do ! [_ (stm.commit (stm.update (dictionary.put path [new_concern directory file_tracker]) tracker))] diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux index 51219b9ea..e4133710e 100644 --- a/stdlib/source/lux/world/net.lux +++ b/stdlib/source/lux/world/net.lux @@ -1,9 +1,5 @@ (.module: - [lux (#- Location) - [control - [try (#+ Try)] - [security - ["!" capability (#+ capability:)]]]]) + [lux (#- Location)]) (type: #export Address Text) @@ -14,12 +10,3 @@ (type: #export Location {#address Address #port Port}) - -(capability: #export (Can-Read ! o) - (can-read Nat (! (Try o)))) - -(capability: #export (Can-Write ! i) - (can-write i (! (Try Any)))) - -(capability: #export (Can-Close !) - (can-close [] (! (Try Any)))) diff --git a/stdlib/source/lux/world/net/http/client.lux b/stdlib/source/lux/world/net/http/client.lux index 145133288..ad11a10ab 100644 --- a/stdlib/source/lux/world/net/http/client.lux +++ b/stdlib/source/lux/world/net/http/client.lux @@ -13,6 +13,7 @@ [data ["." binary (#+ Binary)] ["." maybe ("#\." functor)] + ["." text] [collection ["." dictionary]]] [math @@ -218,3 +219,7 @@ (#try.Failure error) (#try.Failure error))))))) + +(def: #export headers + (-> (List [Text Text]) //.Headers) + (dictionary.from_list text.hash)) diff --git a/stdlib/source/lux/world/net/http/status.lux b/stdlib/source/lux/world/net/http/status.lux index a89a5de82..cb0e8a8af 100644 --- a/stdlib/source/lux/world/net/http/status.lux +++ b/stdlib/source/lux/world/net/http/status.lux @@ -4,77 +4,79 @@ ## https://en.wikipedia.org/wiki/List_of_HTTP_status_codes (template [<status> <name>] - [(def: #export <name> Status <status>)] + [(def: #export <name> + Status + <status>)] ## 1xx Informational response [100 continue] - [101 switching-protocols] + [101 switching_protocols] [102 processing] - [103 early-hints] + [103 early_hints] ## 2xx Success [200 ok] [201 created] [202 accepted] - [203 non-authoritative-information] - [204 no-content] - [205 reset-content] - [206 partial-content] - [207 multi-status] - [208 already-reported] - [226 im-used] + [203 non_authoritative_information] + [204 no_content] + [205 reset_content] + [206 partial_content] + [207 multi_status] + [208 already_reported] + [226 im_used] ## 3xx Redirection - [300 multiple-choices] - [301 moved-permanently] + [300 multiple_choices] + [301 moved_permanently] [302 found] - [303 see-other] - [304 not-modified] - [305 use-proxy] - [306 switch-proxy] - [307 temporary-redirect] - [308 permanent-redirect] + [303 see_other] + [304 not_modified] + [305 use_proxy] + [306 switch_proxy] + [307 temporary_redirect] + [308 permanent_redirect] ## 4xx Client errors - [400 bad-request] + [400 bad_request] [401 unauthorized] - [402 payment-required] + [402 payment_required] [403 forbidden] - [404 not-found] - [405 method-not-allowed] - [406 not-acceptable] - [407 proxy-authentication-required] - [408 request-timeout] + [404 not_found] + [405 method_not_allowed] + [406 not_acceptable] + [407 proxy_authentication_required] + [408 request_timeout] [409 conflict] [410 gone] - [411 length-required] - [412 precondition-failed] - [413 payload-too-large] - [414 uri-too-long] - [415 unsupported-media-type] - [416 range-not-satisfiable] - [417 expectation-failed] - [418 im-a-teapot] - [421 misdirected-request] - [422 unprocessable-entity] + [411 length_required] + [412 precondition_failed] + [413 payload_too_large] + [414 uri_too_long] + [415 unsupported_media_type] + [416 range_not_satisfiable] + [417 expectation_failed] + [418 im_a_teapot] + [421 misdirected_request] + [422 unprocessable_entity] [423 locked] - [424 failed-dependency] - [426 upgrade-required] - [428 precondition-required] - [429 too-many-requests] - [431 request-header-fields-too-large] - [451 unavailable-for-legal-reasons] + [424 failed_dependency] + [426 upgrade_required] + [428 precondition_required] + [429 too_many_requests] + [431 request_header_fields_too_large] + [451 unavailable_for_legal_reasons] ## 5xx Server errors - [500 internal-server-error] - [501 not-implemented] - [502 bad-gateway] - [503 service-unavailable] - [504 gateway-timeout] - [505 http-version-not-supported] - [506 variant-also-negotiates] - [507 insufficient-storage] - [508 loop-detected] - [510 not-extended] - [511 network-authentication-required] + [500 internal_server_error] + [501 not_implemented] + [502 bad_gateway] + [503 service_unavailable] + [504 gateway_timeout] + [505 http_version_not_supported] + [506 variant_also_negotiates] + [507 insufficient_storage] + [508 loop_detected] + [510 not_extended] + [511 network_authentication_required] ) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 0691958b8..d250acfcf 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -10,7 +10,6 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [security - ["!" capability (#+ capability:)] ["?" policy (#+ Context Safety Safe)]] [concurrency ["." atom (#+ Atom)] @@ -33,15 +32,6 @@ [// [file (#+ Path)]]) -(capability: #export (Can_Read !) - (can_read [] (! (Try Text)))) - -(capability: #export (Can_Write !) - (can_write Text (! (Try Any)))) - -(capability: #export (Can_Destroy !) - (can_destroy [] (! (Try Any)))) - (type: #export Exit Int) @@ -54,35 +44,31 @@ [+1 error] ) -(capability: #export (Can_Wait !) - (can_wait [] (! (Try Exit)))) - (interface: #export (Process !) - (: (Can_Read !) + (: (-> [] (! (Try Text))) read) - (: (Can_Read !) + (: (-> [] (! (Try Text))) error) - (: (Can_Write !) + (: (-> Text (! (Try Any))) write) - (: (Can_Destroy !) + (: (-> [] (! (Try Any))) destroy) - (: (Can_Wait !) + (: (-> [] (! (Try Exit))) await)) (def: (async_process process) (-> (Process IO) (Process Promise)) (`` (implementation - (~~ (template [<method> <capability>] + (~~ (template [<method>] [(def: <method> - (<capability> - (|>> (!.use (\ process <method>)) - promise.future)))] - - [read ..can_read] - [error ..can_read] - [write ..can_write] - [destroy ..can_destroy] - [await ..can_wait] + (|>> (\ process <method>) + promise.future))] + + [read] + [error] + [write] + [destroy] + [await] ))))) (type: #export Command @@ -91,23 +77,18 @@ (type: #export Argument Text) -(capability: #export (Can_Execute !) - (can_execute [Environment Path Command (List Argument)] (! (Try (Process !))))) - (interface: #export (Shell !) - (: (Can_Execute !) + (: (-> [Environment Path Command (List Argument)] (! (Try (Process !)))) execute)) (def: #export (async shell) (-> (Shell IO) (Shell Promise)) (implementation - (def: execute - (..can_execute - (function (_ input) - (promise.future - (do (try.with io.monad) - [process (!.use (\ shell execute) input)] - (wrap (..async_process process))))))))) + (def: (execute input) + (promise.future + (do (try.with io.monad) + [process (\ shell execute input)] + (wrap (..async_process process))))))) ## https://en.wikipedia.org/wiki/Code_injection#Shell_injection (interface: (Policy ?) @@ -157,9 +138,9 @@ (: (Context Safety Policy) (function (_ (^open "?\.")) (implementation - (def: command (|>> sanitize_command (!.use ?\can_upgrade))) - (def: argument (|>> sanitize_argument (!.use ?\can_upgrade))) - (def: value (!.use ?\can_downgrade))))))) + (def: command (|>> sanitize_command ?\can_upgrade)) + (def: argument (|>> sanitize_argument ?\can_upgrade)) + (def: value ?\can_downgrade)))))) (def: unix_policy (let [replacer (: Replacer @@ -259,33 +240,27 @@ (wrap (: (Process IO) (`` (implementation (~~ (template [<name> <stream>] - [(def: <name> - (..can_read - (function (_ _) - (do ! - [output (java/io/BufferedReader::readLine <stream>)] - (case output - (#.Some output) - (wrap output) - - #.None - (\ io.monad wrap (exception.throw ..no_more_output [])))))))] + [(def: (<name> _) + (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] )) - (def: write - (..can_write - (function (_ message) - (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output)))) - (~~ (template [<name> <capability> <method>] - [(def: <name> - (<capability> - (function (_ _) - (<method> process))))] - - [destroy ..can_destroy java/lang/Process::destroy] - [await ..can_wait java/lang/Process::waitFor] + (def: (write message) + (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output)) + (~~ (template [<name> <method>] + [(def: (<name> _) + (<method> process))] + + [destroy java/lang/Process::destroy] + [await java/lang/Process::waitFor] )))))))) (import: java/io/File @@ -313,26 +288,24 @@ (implementation: #export default (Shell IO) - (def: execute - (..can_execute - (function (_ [environment working_directory command arguments]) - (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)))))) + (def: (execute [environment working_directory command arguments]) + (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>)} (as_is))) -(interface: #export (Simulation s) +(interface: #export (Mock s) (: (-> s (Try [s Text])) on_read) (: (-> s (Try [s Text])) @@ -344,65 +317,57 @@ (: (-> s (Try [s Exit])) on_await)) -(`` (implementation: (mock_process simulation state) - (All [s] (-> (Simulation s) (Atom s) (Process IO))) - - (~~ (template [<name> <capability> <simulation>] - [(def: <name> - (<capability> - (function (_ _) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation <simulation> |state|) - (#try.Success [|state| output]) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success output))) - - (#try.Failure error) - (wrap (#try.Failure error)))))))] - - [read ..can_read on_read] - [error ..can_read on_error] - [await ..can_wait on_await] +(`` (implementation: (mock_process mock state) + (All [s] (-> (Mock s) (Atom s) (Process IO))) + + (~~ (template [<name> <mock>] + [(def: (<name> _) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock <mock> |state|) + (#try.Success [|state| output]) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success output))) + + (#try.Failure error) + (wrap (#try.Failure error)))))] + + [read on_read] + [error on_error] + [await on_await] )) - (def: write - (..can_write - (function (_ message) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation on_write message |state|) - (#try.Success |state|) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error))))))) - (def: destroy - (..can_destroy - (function (_ _) - (do {! io.monad} - [|state| (atom.read state)] - (case (\ simulation on_destroy |state|) - (#try.Success |state|) - (do ! - [_ (atom.write |state| state)] - (wrap (#try.Success []))) - - (#try.Failure error) - (wrap (#try.Failure error))))))))) - -(implementation: #export (mock simulation init) + (def: (write message) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock on_write message |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))) + (def: (destroy _) + (do {! io.monad} + [|state| (atom.read state)] + (case (\ mock on_destroy |state|) + (#try.Success |state|) + (do ! + [_ (atom.write |state| state)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error))))))) + +(implementation: #export (mock mock init) (All [s] (-> (-> [Environment Path Command (List Argument)] - (Try (Simulation s))) + (Try (Mock s))) s (Shell IO))) - (def: execute - (..can_execute - (function (_ input) - (io.io (do try.monad - [simulation (simulation input)] - (wrap (..mock_process simulation (atom.atom init))))))))) + (def: (execute input) + (io.io (do try.monad + [mock (mock input)] + (wrap (..mock_process mock (atom.atom init))))))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 2d873f8a8..772f57d88 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -11,8 +11,6 @@ ["." exception (#+ exception:)] [parser [environment (#+ Environment)]] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -36,7 +34,10 @@ ["." console (#+ Console)] ["." program (#+ Program)] ["." file (#+ Path) - ["." watch]]]] + ["." watch]] + [net + ["." http #_ + ["#" client]]]]] ["." / #_ ["#" profile] ["#." action (#+ Action)] @@ -65,7 +66,7 @@ (-> /.Profile (List (Repository Promise))) (|>> (get@ #/.repositories) set.to_list - (list\map (|>> (/repository/remote.repository #.None) /repository.async)))) + (list\map (|>> (/repository/remote.repository http.default #.None) /repository.async)))) (def: (with_dependencies program console command profile) (All [a] @@ -155,7 +156,7 @@ (dictionary.get repository (get@ #/.deploy_repositories profile))] [(#.Some artifact) (#.Some repository)] (/command/deploy.do! console - (/repository.async (/repository/remote.repository (#.Some identity) repository)) + (/repository.async (/repository/remote.repository http.default (#.Some identity) repository)) (file.async file.default) artifact profile) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index f74d3069a..5f3d95631 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -5,9 +5,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [collection ["." list] @@ -29,14 +27,14 @@ (def: (targets fs path) (-> (file.System Promise) Path (Promise (List Path))) (do {! promise.monad} - [?root (!.use (\ fs directory) [path])] + [?root (\ fs directory [path])] (case ?root (#try.Success root) (loop [root root] (do ! [subs (\ ! map (|>> (try.default (list))) - (!.use (\ root directories) []))] - (\ ! map (|>> list.concat (list& (!.use (\ root scope) []))) + (\ root directories []))] + (\ ! map (|>> list.concat (list& (\ root scope))) (monad.map ! recur subs)))) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 6d61475d0..572ebf0f0 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -7,9 +7,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data ["." product] ["." maybe] @@ -140,7 +138,7 @@ (let [[read! write!] (: [(Promise (Try Any)) (promise.Resolver (Try Any))] (promise.promise [])) - _ (|> (!.use (\ process <capability>) []) + _ (|> (\ process <capability> []) (promise.await (function (recur ?line) (case ?line (#try.Failure error) @@ -156,7 +154,7 @@ (#try.Success _) (promise.await recur - (!.use (\ process <capability>) [])))) + (\ process <capability> [])))) (console.write_line line console))))) io.run)] read!))] @@ -188,19 +186,18 @@ / (\ 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)))]) + process (\ 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) []) + exit (\ process await []) _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index b966fe85e..142451113 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -5,8 +5,6 @@ [control ["." try (#+ Try)] ["." exception] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise)]]] [data @@ -24,9 +22,9 @@ (-> (Directory Promise) (Promise (Try Any))) (do {! ///action.monad} [nodes (: (Promise (Try (List (File Promise)))) - (!.use (\ root files) [])) + (\ root files [])) _ (monad.map ! (function (_ node) - (!.use (\ node delete) [])) + (\ node delete [])) nodes)] (wrap []))) @@ -39,7 +37,7 @@ (do promise.monad [#let [target (get@ #///.target profile)] root (: (Promise (Try (Directory Promise))) - (!.use (\ fs directory) target))] + (\ fs directory target))] (case root (#try.Success root) (do {! ///action.monad} @@ -47,9 +45,9 @@ (do ! [_ (..clean_files! root) subs (: (Promise (Try (List (Directory Promise)))) - (!.use (\ root directories) [])) + (\ root directories [])) _ (monad.map ! recur subs)] - (!.use (\ root discard) [])))] + (\ root discard [])))] (console.write_line (..success target) console)) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 2e5ce6d89..4b6b96e3e 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -6,9 +6,7 @@ ["." try (#+ Try)] ["." exception] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] [text diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 16d036718..b8a728904 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -4,8 +4,6 @@ [monad (#+ do)]] [control ["." try (#+ Try)] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -37,6 +35,6 @@ outcome (|> pom (\ xml.codec encode) (\ utf8.codec encode) - (!.use (\ file over_write))) + (\ file over_write)) _ (console.write_line ..success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index f3ab6c12a..e8b5a2a23 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -4,9 +4,7 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [text ["%" format (#+ format)]]] @@ -44,14 +42,13 @@ #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 - compiler_command - compiler_parameters]) + process (\ shell execute [environment + working_directory + compiler_command + compiler_parameters]) _ (//build.log_output! console process) _ (//build.log_error! console process) - exit (!.use (\ process await) []) + exit (\ process await []) _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 0fdf7956f..edfa3142b 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] ["." product] @@ -19,17 +17,12 @@ [collection ["." dictionary] ["." set (#+ Set)] - ["." list ("#\." monoid)]] - [format - ["." xml]]] + ["." list ("#\." monoid)]]] [time - ["." instant (#+ Instant)]] - [world - [program (#+ Program)] - ["." file (#+ Path File Directory)]]] + ["." instant (#+ Instant)]]] ["." /// #_ - ["#" local] - ["#." hash (#+ Hash SHA-1 MD5)] + [repository (#+ Repository)] + ["#." hash (#+ Hash)] ["#." package (#+ Package)] ["#." artifact (#+ Artifact) ["#/." time] @@ -37,16 +30,14 @@ ["#/." extension (#+ Extension)] ["#/." versioning] ["#/." snapshot - ["#/." version (#+ Version) + ["#/." version ["#/." value]]]] - ["#." metadata + ["#." metadata #_ ["#/." artifact] ["#/." snapshot (#+ Metadata)]] ["#." dependency (#+ Dependency) [resolution (#+ Resolution)] - ["#/." status (#+ Status)]] - ["#." repository (#+ Repository) - ["#/." origin]]]) + ["#/." status (#+ Status)]]]) (def: (with_status repository version_template [artifact type] [data status]) (-> (Repository Promise) ///artifact.Version Dependency [Binary Status] (Promise (Try Any))) @@ -150,8 +141,7 @@ (def: #export (all repository resolution) (-> (Repository Promise) Resolution (Promise (Try (Set Artifact)))) - (do {! (try.with promise.monad)} - [] + (let [! (try.with promise.monad)] (|> (dictionary.entries resolution) (monad.map ! (function (_ [dependency package]) (..one repository dependency package))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 2d92e1438..138ee31bf 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -33,7 +33,9 @@ ["." i64]]] [world [net (#+ URL) - ["." uri]]]] + ["." uri] + ["." http #_ + ["#" client]]]]] ["." // (#+ Dependency) ["#." status (#+ Status)] ["/#" // #_ @@ -214,7 +216,7 @@ ///package.repositories (try\map set.to_list) (try.default (list)) - (list\map (|>> (///repository/remote.repository #.None) + (list\map (|>> (///repository/remote.repository http.default #.None) ///repository.async)) (list\compose repositories))] [successes failures resolution] (recur sub_repositories diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index 8c4db9ddd..f501ebc8b 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -27,12 +27,10 @@ ..any_equivalence ($_ sum.equivalence ///hash.equivalence - ///hash.equivalence - ) + ///hash.equivalence) ($_ product.equivalence ///hash.equivalence - ///hash.equivalence - ) + ///hash.equivalence) )) (def: #export (verified payload) diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index b00829469..2e7dbbab6 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -6,9 +6,7 @@ [pipe (#+ do>)] ["." try (#+ Try)] [parser - ["<c>" code]] - [security - ["!" capability]]] + ["<.>" code]]] [data [binary (#+ Binary)] ["." text @@ -46,13 +44,13 @@ (|>> (do> try.monad [(\ utf8.codec decode)] [..parse_lux] - [(list) (<c>.run //parser.project)]))) + [(list) (<code>.run //parser.project)]))) (def: #export (read monad fs profile) (All [!] (-> (Monad !) (file.System !) Text (! (Try Profile)))) (do (try.with monad) - [project_file (!.use (\ fs file) //project.file) - project_file (!.use (\ project_file content) [])] + [project_file (\ fs file //project.file) + project_file (\ project_file content [])] (\ monad wrap (|> project_file (do> try.monad diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux index 08dab9ed3..86981eb62 100644 --- a/stdlib/source/program/aedifex/metadata.lux +++ b/stdlib/source/program/aedifex/metadata.lux @@ -1,12 +1,34 @@ (.module: [lux #* + [data + [text + ["%" format (#+ format)]]] [world - [file (#+ Path)]]]) + [file (#+ Path)] + [net + ["." uri (#+ URI)]]]] + ["." // #_ + ["#." artifact (#+ Artifact)]]) (def: #export remote_file Path "maven-metadata.xml") +(def: #export (remote_artifact_uri artifact) + (-> Artifact URI) + (let [/ uri.separator] + (format (get@ #//artifact.group artifact) + / (get@ #//artifact.name artifact) + / (get@ #//artifact.version artifact) + / ..remote_file))) + +(def: #export (remote_project_uri artifact) + (-> Artifact URI) + (let [/ uri.separator] + (format (get@ #//artifact.group artifact) + / (get@ #//artifact.name artifact) + / ..remote_file))) + (def: #export local_file Path "maven-metadata-local.xml") diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index f871954c3..acfa7bd62 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -19,7 +19,7 @@ [set (#+ Set)]]]] ["." // #_ ["/" profile] - ["#." hash (#+ Hash SHA-1 MD5)] + ["#." hash] ["#." pom] [dependency (#+ Dependency) ["#." status (#+ Status)]] @@ -49,10 +49,14 @@ (def: #export (local pom library) (-> XML Binary Package) {#origin (#//origin.Local "") - #library [library #//status.Unverified] - #pom [pom - (|> pom (\ xml.codec encode) (\ utf8.codec encode)) - #//status.Unverified]}) + #library [library + (#//status.Verified (//hash.sha-1 library) + (//hash.md5 library))] + #pom (let [binary_pom (|> pom (\ xml.codec encode) (\ utf8.codec encode))] + [pom + binary_pom + (#//status.Verified (//hash.sha-1 binary_pom) + (//hash.md5 binary_pom))])}) (def: #export dependencies (-> Package (Try (Set Dependency))) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index c5f822633..d966c7f82 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -30,21 +30,21 @@ (promise.future (\ repository upload uri content))) )) -(interface: #export (Simulation s) +(interface: #export (Mock s) (: (-> URI s (Try [s Binary])) on_download) (: (-> URI Binary s (Try s)) on_upload)) -(def: #export (mock simulation init) - (All [s] (-> (Simulation s) s (Repository Promise))) +(def: #export (mock mock init) + (All [s] (-> (Mock s) s (Repository Promise))) (let [state (stm.var init)] (implementation (def: (download uri) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on_download uri |state|) + (case (\ mock on_download uri |state|) (#try.Success [|state| output]) (do ! [_ (stm.write |state| state)] @@ -57,7 +57,7 @@ (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on_upload uri content |state|) + (case (\ mock on_upload uri content |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 2841bbd32..8ceaf5ffc 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." text ["%" format (#+ format)]]] @@ -46,7 +44,7 @@ (: (Promise (Try (File Promise))) (file.get_file promise.monad system absolute_path))) (: (Promise (Try (File Promise))) - (!.use (\ system file) absolute_path))))) + (\ system file absolute_path))))) (implementation: #export (repository program system) (-> (Program Promise) (file.System Promise) (//.Repository Promise)) @@ -54,9 +52,9 @@ (def: (download uri) (do {! (try.with promise.monad)} [file (..file program system false uri)] - (!.use (\ file content) []))) + (\ file content []))) (def: (upload uri content) (do {! (try.with promise.monad)} [file (..file program system true uri)] - (!.use (\ file over_write) [content])))) + (\ file over_write content)))) diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux index dcf1e1d51..50115f123 100644 --- a/stdlib/source/program/aedifex/repository/remote.lux +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -1,19 +1,15 @@ (.module: [lux #* - [ffi (#+ import:)] [abstract [monad (#+ do)]] [control ["." io (#+ IO)] - ["." try] + ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - ["." binary] - ["." text + ["." product] + [text ["%" format (#+ format)]]] - [math - [number - ["n" nat]]] [tool [compiler ["." version] @@ -22,7 +18,11 @@ ["#" version]]]]] [world [net (#+ URL) - [uri (#+ URI)]]]] + [uri (#+ URI)] + ["." http #_ + ["#" client] + ["#/." status] + ["@#" /]]]]] ["." // ["#." identity (#+ Identity)] ["/#" // #_ @@ -32,108 +32,64 @@ (type: #export Address URL) -(import: java/lang/String) +(template [<name>] + [(exception: #export (<name> {url URL} {status Nat}) + (exception.report + ["URL" (%.text url)] + ["Status Code" (%.nat status)]))] -(import: java/lang/AutoCloseable - ["#::." - (close [] #io #try void)]) - -(import: java/io/InputStream) - -(import: java/io/OutputStream - ["#::." - (flush [] #io #try void) - (write [[byte]] #io #try void)]) - -(import: java/net/URLConnection - ["#::." - (setDoOutput [boolean] #io #try void) - (setRequestProperty [java/lang/String java/lang/String] #io #try void) - (getInputStream [] #io #try java/io/InputStream) - (getOutputStream [] #io #try java/io/OutputStream)]) - -(import: java/net/HttpURLConnection - ["#::." - (setRequestMethod [java/lang/String] #io #try void) - (getResponseCode [] #io #try int)]) - -(import: java/net/URL - ["#::." - (new [java/lang/String]) - (openConnection [] #io #try java/net/URLConnection)]) - -(import: java/io/BufferedInputStream - ["#::." - (new [java/io/InputStream]) - (read [[byte] int int] #io #try int)]) - -(exception: #export (no_credentials {address Address}) - (exception.report - ["Address" (%.text address)])) - -(exception: #export (deployment_failure {code Int}) - (exception.report - ["Code" (%.int code)])) + [download_failure] + [upload_failure] + ) (def: #export (uri version_template artifact extension) (-> Version Artifact Extension URI) (format (///artifact.uri version_template artifact) extension)) -(def: buffer_size - (n.* 1,024 1,024)) - -(def: user_agent +(def: #export user_agent (format "LuxAedifex/" (version.format language/lux.version))) -(implementation: #export (repository identity address) - (All [s] (-> (Maybe Identity) Address (//.Repository IO))) +(def: base_headers + (List [Text Text]) + (list ["User-Agent" ..user_agent])) + +(implementation: #export (repository http identity address) + (All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO))) (def: (download uri) (do {! (try.with io.monad)} - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "GET" connection) - _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection) - input (|> connection - java/net/URLConnection::getInputStream - (\ ! map (|>> java/io/BufferedInputStream::new))) - #let [buffer (binary.create ..buffer_size)]] - (loop [output (\ binary.monoid identity)] + [[status message] (: (IO (Try (@http.Response IO))) + (http.get (format address uri) + (http.headers ..base_headers) + #.None + http))] + (case status + (^ (static http/status.ok)) + (\ ! map product.right ((get@ #@http.body message) #.None)) + + _ (do ! - [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)] - (case bytes_read - -1 (do ! - [_ (java/lang/AutoCloseable::close input)] - (wrap output)) - +0 (recur output) - _ (if (n.= ..buffer_size bytes_read) - (recur (\ binary.monoid compose output buffer)) - (do ! - [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))] - (recur (\ binary.monoid compose output chunk))))))))) + [_ ((get@ #@http.body message) (#.Some 0))] + (\ io.monad wrap (exception.throw ..download_failure [(format address uri) status])))))) (def: (upload uri content) - (case identity - #.None - (\ io.monad wrap (exception.throw ..no_credentials [address])) - - (#.Some [user password]) - (do (try.with io.monad) - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) - _ (java/net/URLConnection::setDoOutput true connection) - _ (java/net/URLConnection::setRequestProperty "Authorization" (//identity.basic_auth user password) connection) - stream (java/net/URLConnection::getOutputStream connection) - _ (java/io/OutputStream::write content stream) - _ (java/io/OutputStream::flush stream) - _ (java/lang/AutoCloseable::close stream) - code (java/net/HttpURLConnection::getResponseCode connection)] - (case code - +201 (wrap []) - _ (\ io.monad wrap (exception.throw ..deployment_failure [code])))))) + (do (try.with io.monad) + [[status message] (: (IO (Try (@http.Response IO))) + (http.put (format address uri) + (http.headers (case identity + #.None + ..base_headers + + (#.Some [user password]) + (list& ["Authorization" (//identity.basic_auth user password)] + ..base_headers))) + (#.Some content) + http)) + _ ((get@ #@http.body message) (#.Some 0))] + (case status + (^ (static http/status.created)) + (wrap []) + + _ + (\ io.monad wrap (exception.throw ..upload_failure [(format address uri) status]))))) ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 557e9d22a..f443301db 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -8,8 +8,6 @@ [control ["." io (#+ IO io)] ["." try (#+ Try)] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -97,14 +95,14 @@ (! (Try (File !))) (:assume (file.get_file monad file_system package)))] - (!.use (\ (:share [!] - (Monad !) - monad - - (File !) - (:assume package)) - over_write) - [content])) + (\ (:share [!] + (Monad !) + monad + + (File !) + (:assume package)) + over_write + content)) (#try.Failure error) (\ monad wrap (#try.Failure error)))} @@ -118,7 +116,7 @@ (do (try.with monad) [package (: (Promise (Try (File Promise))) (file.get_file monad file_system package))] - (!.use (\ (: (File Promise) package) over_write) [content])) + (\ (: (File Promise) package) over_write content)) (#try.Failure error) (\ monad wrap (#try.Failure error)))))))) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 2c764aff9..238034534 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -5,9 +5,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." text ["%" format (#+ format)]] @@ -72,4 +70,4 @@ (format target (\ system separator) ..file)))] (|> tar (binary.run tar.writer) - (!.use (\ package over_write))))) + (\ package over_write)))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 7b4a9262e..19a2d7607 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -7,8 +7,6 @@ ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]] ["<>" parser ["<b>" binary]]] [data @@ -47,8 +45,8 @@ (-> (file.System Promise) Library Import (Action Import)) (do (try.with promise.monad) [file (: (Action (File Promise)) - (!.use (\ system file) [library])) - binary (!.use (\ file content) [])] + (\ system file library)) + binary (\ file content [])] (promise\wrap (do {! try.monad} [tar (<b>.run tar.parser binary)] diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux index 5bfcf1ff8..7dedd72cb 100644 --- a/stdlib/source/spec/lux/world/console.lux +++ b/stdlib/source/spec/lux/world/console.lux @@ -6,8 +6,6 @@ [control [io (#+ IO)] ["." try] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise)]]] [data @@ -20,36 +18,40 @@ (def: #export (spec console) (-> (IO (/.Console Promise)) Test) - (<| (_.for [/.Console]) - (do {! random.monad} - [message (random.ascii/alpha 10)] - (wrap (do promise.monad - [console (promise.future console) - ?write (!.use (\ console write) [(format message text.new_line)]) - ?read (!.use (\ console read) []) - ?read_line (!.use (\ console read_line) []) - ?close/good (!.use (\ console close) []) - ?close/bad (!.use (\ console close) [])] - ($_ _.and' - (_.cover' [/.Can_Write] - (case ?write - (#try.Success _) - true - - _ - false)) - (_.cover' [/.Can_Read] - (case [?read ?read_line] - [(#try.Success _) (#try.Success _)] - true + (do random.monad + [message (random.ascii/alpha 10)] + (wrap (do promise.monad + [console (promise.future console) + ?write (\ console write (format message text.new_line)) + ?read (\ console read []) + ?read_line (\ console read_line []) + ?close/good (\ console close []) + ?close/bad (\ console close []) - _ - false)) - (_.cover' [/.Can_Close] - (case [?close/good ?close/bad] - [(#try.Success _) (#try.Failure _)] - true - - _ - false)) - )))))) + #let [can_write! + (case ?write + (#try.Success _) + true + + _ + false) + + can_read! + (case [?read ?read_line] + [(#try.Success _) (#try.Success _)] + true + + _ + false) + + can_close! + (case [?close/good ?close/bad] + [(#try.Success _) (#try.Failure _)] + true + + _ + false)]] + (_.cover' [/.Console] + (and can_write! + can_read! + can_close!)))))) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 15e3012d0..8ff65a2c7 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -4,11 +4,9 @@ [abstract [monad (#+ do)]] [control - ["." try] - [security - ["!" capability]] + ["." try ("#\." functor)] [concurrency - ["." promise (#+ Promise)]] + ["." promise (#+ Promise) ("#\." monad)]] [parser ["." environment (#+ Environment)]]] [data @@ -34,64 +32,59 @@ [sleep! "sleep" Nat %.nat] ) -(def: (read_test expected process) - (-> Text (/.Process Promise) _.Assertion) - (do promise.monad - [?read (!.use (\ process read) []) - ?await (!.use (\ process await) [])] - ($_ _.and' - (_.cover' [/.Can_Read] - (case ?read - (#try.Success actual) - (text\= expected actual) - - (#try.Failure error) - false)) - (_.cover' [/.Can_Wait /.Exit /.normal] - (case ?await - (#try.Success exit) - (i.= /.normal exit) - - (#try.Failure error) - false)) - ))) - -(def: (destroy_test process) +(def: (can_wait! process) (-> (/.Process Promise) _.Assertion) + (|> (\ process await []) + (promise\map (|>> (try\map (i.= /.normal)) + (try.default false) + (_.cover' [/.Exit /.normal]))) + promise\join)) + +(def: (can_read! expected process) + (-> Text (/.Process Promise) (Promise Bit)) + (|> (\ process read []) + (promise\map (|>> (try\map (text\= expected)) + (try.default false))))) + +(def: (can_destroy! process) + (-> (/.Process Promise) (Promise Bit)) (do promise.monad - [?destroy (!.use (\ process destroy) []) - ?await (!.use (\ process await) [])] - (_.cover' [/.Can_Destroy] - (and (case ?destroy - (#try.Success _) - true - - (#try.Failure error) - false) - (case ?await - (#try.Success _) - false - - (#try.Failure error) - true))))) + [?destroy (\ process destroy []) + ?await (\ process await [])] + (wrap (and (case ?destroy + (#try.Success _) + true + + (#try.Failure error) + false) + (case ?await + (#try.Success _) + false + + (#try.Failure error) + true))))) -(with_expansions [<shell_coverage> (as_is [/.Can_Execute /.Command /.Argument])] +(with_expansions [<shell_coverage> (as_is [/.Command /.Argument])] (def: #export (spec shell) (-> (/.Shell Promise) Test) (<| (_.for [/.Shell /.Process]) (do {! random.monad} [message (random.ascii/alpha 10) seconds (\ ! map (|>> (n.% 5) (n.+ 5)) random.nat)] - (wrap (do promise.monad - [?echo (!.use (\ shell execute) (..echo! message)) - ?sleep (!.use (\ shell execute) (..sleep! seconds))] + (wrap (do {! promise.monad} + [?echo (\ shell execute (..echo! message)) + ?sleep (\ shell execute (..sleep! seconds))] (case [?echo ?sleep] [(#try.Success echo) (#try.Success sleep)] - ($_ _.and' - (_.cover' <shell_coverage> - true) - (..read_test message echo) - (..destroy_test sleep)) + (do ! + [can_read! (..can_read! message echo) + can_destroy! (..can_destroy! sleep)] + ($_ _.and' + (_.cover' <shell_coverage> + (and can_read! + can_destroy!)) + (..can_wait! echo) + )) _ (_.cover' <shell_coverage> diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index e3c2bd1eb..09ffcd3d8 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -9,6 +9,7 @@ ["#." cli] ["#." command] ["#." dependency + ["#/." deployment] ["#/." resolution] ["#/." status]] ["#." hash] @@ -27,6 +28,7 @@ Test ($_ _.and /dependency.test + /dependency/deployment.test /dependency/resolution.test /dependency/status.test )) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 7ef74d2c0..0808c7d21 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -9,9 +9,7 @@ ["." environment (#+ Environment)]] [concurrency ["." atom (#+ Atom)] - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." text ["%" format (#+ format)] @@ -62,7 +60,7 @@ (if (n.= expected_runs actual_runs) (wrap (#try.Failure end_signal)) (do (try.with !) - [_ (!.use (\ dummy_file over_write) (\ utf8.codec encode (%.nat actual_runs)))] + [_ (\ dummy_file over_write (\ utf8.codec encode (%.nat actual_runs)))] (do ! [_ (promise.future (atom.write actual_runs @runs))] (wrap (#try.Success [])))))))])) @@ -99,8 +97,8 @@ ($_ _.and (wrap (do promise.monad [verdict (do ///action.monad - [_ (!.use (\ fs create_directory) [source]) - dummy_file (!.use (\ fs create_file) [dummy_path]) + [_ (\ fs create_directory source) + dummy_file (\ fs create_file dummy_path) #let [[@runs command] (..command expected_runs end_signal dummy_file)] _ (\ watcher poll [])] (do promise.monad diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 0e86ef946..9d37ceb00 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -10,9 +10,7 @@ [concurrency ["." promise (#+ Promise)]] [parser - ["." environment]] - [security - ["!" capability]]] + ["." environment]]] [data ["." text ("#\." equivalence)] [collection @@ -42,7 +40,7 @@ (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success - (: (shell.Simulation []) + (: (shell.Mock []) (implementation (def: (on_read state) (exception.throw shell.no_more_output [])) @@ -60,7 +58,7 @@ (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success - (: (shell.Simulation []) + (: (shell.Mock []) (implementation (def: (on_read state) (exception.throw shell.no_more_output [])) @@ -142,8 +140,8 @@ (wrap (do promise.monad [verdict (do ///action.monad [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution profile) - start (!.use (\ console read_line) []) - end (!.use (\ console read_line) [])] + start (\ console read_line []) + end (\ console read_line [])] (wrap (and (text\= /.start start) (text\= /.success end))))] (_.cover' [/.do! @@ -156,8 +154,8 @@ (wrap (do promise.monad [verdict (do ///action.monad [_ (/.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) [])] + start (\ console read_line []) + end (\ console read_line [])] (wrap (and (text\= /.start start) (text\= /.failure end))))] (_.cover' [/.failure] diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 705cca7f2..18997e02e 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] ["." product] @@ -55,7 +53,7 @@ (do {! (try.with promise.monad)} [file (: (Promise (Try (File Promise))) (file.get_file promise.monad fs path))] - (!.use (\ file over_write) content))) + (\ file over_write content))) (def: (create_directory! fs path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any))) @@ -111,7 +109,7 @@ context_exists!/post (..directory_exists? fs context) target_exists!/post (..assets_exist? fs target_path direct_files) sub_exists!/post (..assets_exist? fs sub_path sub_files) - logging (!.use (\ console read_line) [])] + logging (\ console read_line [])] (wrap (and (and context_exists!/pre context_exists!/post) (and target_exists!/pre diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 7e1bf166e..fd4395935 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -8,8 +8,6 @@ ["." exception] [concurrency ["." promise (#+ Promise)]] - [security - ["!" capability]] [parser ["." environment (#+ Environment)]]] [data @@ -80,7 +78,7 @@ [#let [console (@version.echo "")] _ (..make_sources! fs (get@ #///.sources profile)) _ (/.do! console repository fs artifact profile)] - (!.use (\ console read_line) []))) + (\ console read_line []))) (def: #export test Test @@ -96,7 +94,7 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) - #let [repository (///repository.mock @repository.simulation + #let [repository (///repository.mock @repository.mock @repository.empty) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 2b4898dd3..ecb34437a 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -8,8 +8,6 @@ ["." try] [concurrency ["." promise]] - [security - ["!" capability]] [parser ["." environment]]] [data diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 8096fc2b2..bb52b3cca 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -8,8 +8,6 @@ ["." exception] [concurrency ["." promise (#+ Promise)]] - [security - ["!" capability]] [parser ["." environment (#+ Environment)]]] [data @@ -70,7 +68,7 @@ [#let [console (@version.echo "")] _ (..make_sources! fs (get@ #///.sources sample)) _ (/.do! console fs (///repository/local.repository program fs) sample)] - (!.use (\ console read_line) []))) + (\ console read_line []))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index f7f182225..0338bf7c4 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try) ("#\." functor)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." binary] ["." text ("#\." equivalence) @@ -51,11 +49,11 @@ (\ ! wrap)) file (: (Promise (Try (File Promise))) (file.get_file promise.monad fs path)) - actual (!.use (\ file content) []) + actual (\ file content []) logging! (\ ///action.monad map (text\= /.success) - (!.use (\ console read_line) [])) + (\ console read_line [])) #let [expected_path! (text\= ///pom.file path) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index cad06aa69..47e2ed2b3 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -9,9 +9,7 @@ [concurrency ["." promise]] [parser - ["." environment]] - [security - ["!" capability]]] + ["." environment]]] [data ["." text ("#\." equivalence)] [collection @@ -65,10 +63,10 @@ (wrap (do promise.monad [verdict (do ///action.monad [_ (/.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) []) - test_end (!.use (\ console read_line) [])] + build_start (\ console read_line []) + build_end (\ console read_line []) + test_start (\ console read_line []) + test_end (\ console read_line [])] (wrap (and (and (text\= //build.start build_start) (text\= //build.success build_end)) (and (text\= /.start test_start) @@ -83,7 +81,7 @@ [#let [bad_shell (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success - (: (shell.Simulation []) + (: (shell.Mock []) (implementation (def: (on_read state) (exception.throw shell.no_more_output [])) @@ -99,10 +97,10 @@ shell.error)])))))) [])] _ (/.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) []) - test_end (!.use (\ console read_line) [])] + build_start (\ console read_line []) + build_end (\ console read_line []) + test_start (\ console read_line []) + test_end (\ console read_line [])] (wrap (and (and (text\= //build.start build_start) (text\= //build.success build_end)) (and (text\= /.start test_start) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index 079b0fde4..1bbb7f874 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -7,9 +7,7 @@ ["." try] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." maybe] ["." text ("#\." equivalence) @@ -23,7 +21,7 @@ ["#/." lux #_ ["#" version]]]]] [world - ["." console (#+ Console Simulation)]]] + ["." console (#+ Console Mock)]]] [/// ["@." profile]] {#program @@ -31,8 +29,8 @@ (exception: #export console_is_closed!) -(implementation: simulation - (Simulation [Bit Text]) +(implementation: mock + (Mock [Bit Text]) (def: (on_read [open? state]) (if open? @@ -61,7 +59,7 @@ (def: #export echo (-> Text (Console Promise)) (|>> [true] - (console.mock ..simulation) + (console.mock ..mock) console.async)) (def: #export test @@ -73,7 +71,7 @@ [#let [console (..echo "")] verdict (do (try.with promise.monad) [_ (/.do! console profile) - logging (!.use (\ console read_line) [])] + logging (\ console read_line [])] (wrap (text\= (version.format language/lux.version) logging)))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux new file mode 100644 index 000000000..b947e609e --- /dev/null +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -0,0 +1,203 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." hash (#+ Hash)]] + [control + ["." io (#+ IO)] + ["." try ("#\." functor)] + [concurrency + ["." atom (#+ Atom)] + ["." promise]]] + [data + ["." product] + ["." maybe ("#\." functor)] + ["." binary (#+ Binary) ("#\." equivalence)] + ["." text + ["%" format (#+ format)]] + [collection + ["." dictionary (#+ Dictionary)] + ["." set] + ["." list ("#\." fold)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]] + [world + [net (#+ URL) + ["." uri (#+ URI)] + ["." http #_ + ["#" client] + ["#/." status] + ["@#" /]]]]] + ["$." // + ["#/" // #_ + ["#." package]]] + {#program + ["." / + [// (#+ Dependency) + ["." resolution] + [// + ["." profile] + ["." metadata] + ["." package (#+ Package)] + ["." artifact (#+ Artifact) ("#\." equivalence) + ["#/." type] + ["#/." extension]] + ["." repository + ["." remote]]]]]}) + +(def: good_upload + (@http.Response IO) + [http/status.created + {#@http.headers (http.headers (list)) + #@http.body (function (_ _) + (|> [0 (binary.create 0)] + #try.Success + io.io))}]) + +(type: Cache + (Atom (Dictionary URL Binary))) + +(def: (http cache) + (-> Cache (http.Client IO)) + (implementation + (def: (request method url headers input) + (do io.monad + [_ (: (IO Any) + (case [method input] + [#@http.Put (#.Some input)] + (atom.update (dictionary.put url input) cache) + + _ + (wrap [])))] + (wrap (#try.Success ..good_upload)))))) + +(def: (verify_one expected_deployments address package cache expected_artifact actual_artifact) + (-> Nat URL Package (Dictionary URL Binary) Artifact Artifact Bit) + (let [url (: (-> URI URL) + (|>> (format address))) + library_url (url (format (artifact.uri (get@ #artifact.version expected_artifact) + expected_artifact) + artifact/extension.lux_library)) + pom_url (url (format (artifact.uri (get@ #artifact.version expected_artifact) + expected_artifact) + artifact/extension.pom)) + artifact_metadata_url (url (metadata.remote_artifact_uri expected_artifact)) + project_metadata_url (url (metadata.remote_project_uri expected_artifact)) + + expected_library (|> package + (get@ #package.library) + product.left) + expected_pom (|> package + (get@ #package.pom) + product.right + product.left) + + correct_artifact! + (artifact\= expected_artifact actual_artifact) + + expected_number_of_uploads! + (n.= (n.* expected_deployments 8) + (dictionary.size cache)) + + correct_library_upload! + (and (|> cache + (dictionary.get library_url) + (maybe\map (binary\= expected_library)) + (maybe.default false)) + (dictionary.key? cache (format library_url artifact/extension.sha-1)) + (dictionary.key? cache (format library_url artifact/extension.md5))) + + correct_pom_upload! + (and (|> cache + (dictionary.get pom_url) + (maybe\map (binary\= expected_pom)) + (maybe.default false)) + (dictionary.key? cache (format pom_url artifact/extension.sha-1)) + (dictionary.key? cache (format pom_url artifact/extension.md5))) + + artifact_metadata_upload! + (dictionary.key? cache artifact_metadata_url) + + project_metadata_upload! + (dictionary.key? cache project_metadata_url)] + (and correct_artifact! + expected_number_of_uploads! + correct_library_upload! + correct_pom_upload! + artifact_metadata_upload! + project_metadata_upload!))) + +(def: bundle + (Random [Dependency Artifact Package]) + (do random.monad + [[profile package] $///package.random + #let [artifact (|> profile + (get@ #profile.identity) + maybe.assume) + dependency (: Dependency + [artifact + artifact/type.lux_library])]] + (wrap [dependency artifact package]))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [address (\ ! map (text.suffix uri.separator) + (random.ascii/upper 10))] + ($_ _.and + (do {! random.monad} + [[dependency expected_artifact package] ..bundle + #let [cache (: Cache + (atom.atom (dictionary.new text.hash))) + http (..http cache) + repository (repository.async (remote.repository http #.None address))]] + (wrap (do promise.monad + [?outcome (/.one repository dependency package) + cache (promise.future (atom.read cache))] + (_.cover' [/.one] + (|> ?outcome + (try\map (verify_one 1 address package cache expected_artifact)) + (try.default false)))))) + (do {! random.monad} + [#let [hash (: (Hash [Dependency Artifact Package]) + (\ hash.functor map (|>> product.right product.left product.left) + text.hash))] + num_bundles (\ ! map (n.% 10) random.nat) + bundles (|> ..bundle + (random.set hash num_bundles) + (\ ! map set.to_list)) + #let [resolution (list\fold (function (_ [dependency expected_artifact package] resolution) + (dictionary.put dependency package resolution)) + resolution.empty + bundles) + cache (: Cache + (atom.atom (dictionary.new text.hash))) + http (..http cache) + repository (repository.async (remote.repository http #.None address))]] + (wrap (do promise.monad + [?outcome (/.all repository resolution) + cache (promise.future (atom.read cache))] + (_.cover' [/.all] + (|> ?outcome + (try\map (function (_ actual_artifacts) + (let [expected_deployments! + (n.= num_bundles (set.size actual_artifacts)) + + every_deployment_was_correct! + (list.every? (function (_ [dependency expected_artifact package]) + (let [deployed! + (set.member? actual_artifacts expected_artifact) + + deployed_correctly! + (verify_one num_bundles address package cache expected_artifact expected_artifact)] + (and deployed! + deployed_correctly!))) + bundles)] + (and expected_deployments! + every_deployment_was_correct!)))) + (try.default false)))))) + )))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index ebb32b790..7dcf46d3a 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -43,7 +43,7 @@ ["#." artifact (#+ Artifact) ["#/." type] ["#/." extension]] - ["#." repository (#+ Simulation) + ["#." repository (#+ Mock) ["#/." origin]]]]}) (def: random @@ -56,43 +56,7 @@ package /.empty)))) -(def: #export (single artifact package) - (-> Artifact Package (Simulation Any)) - (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] - (implementation - (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) - ## (\ 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"))))) - -(def: lux_sha1 +(def: lux_sha-1 Text (format ///artifact/extension.lux_library ///artifact/extension.sha-1)) @@ -100,7 +64,7 @@ Text (format ///artifact/extension.lux_library ///artifact/extension.md5)) -(def: pom_sha1 +(def: pom_sha-1 Text (format ///artifact/extension.pom ///artifact/extension.sha-1)) @@ -108,7 +72,7 @@ Text (format ///artifact/extension.pom ///artifact/extension.md5)) -(def: sha1 +(def: sha-1 (-> Binary Binary) (|>> ///hash.sha-1 (\ ///hash.sha-1_codec encode) @@ -120,8 +84,48 @@ (\ ///hash.md5_codec encode) (\ utf8.codec encode))) +(def: #export (single artifact package) + (-> Artifact Package (Mock Any)) + (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] + (implementation + (def: (on_download uri state) + (if (text.contains? expected uri) + (let [library (: Binary + (|> package + (get@ #///package.library) + product.left)) + pom (: Binary + (|> package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode)))] + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state library]) + + (text.ends_with? ..lux_sha-1 uri) + (#try.Success [state (..sha-1 library)]) + + (text.ends_with? ..lux_md5 uri) + (#try.Success [state (..md5 library)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state pom]) + + (text.ends_with? ..pom_sha-1 uri) + (#try.Success [state (..sha-1 pom)]) + + (text.ends_with? ..pom_md5 uri) + (#try.Success [state (..md5 pom)]) + + ## else + (#try.Failure "NOPE"))) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE"))))) + (def: (bad_sha-1 expected_artifact expected_package dummy_package) - (-> Artifact Package Package (Simulation Any)) + (-> Artifact Package Package (Mock Any)) (implementation (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) @@ -130,17 +134,17 @@ (get@ #///package.library) product.left)]) - (text.ends_with? lux_sha1 uri) + (text.ends_with? ..lux_sha-1 uri) (#try.Success [state (|> expected_package (get@ #///package.library) product.left - sha1)]) + ..sha-1)]) - (text.ends_with? lux_md5 uri) + (text.ends_with? ..lux_md5 uri) (#try.Success [state (|> expected_package (get@ #///package.library) product.left - md5)]) + ..md5)]) (text.ends_with? ///artifact/extension.pom uri) (#try.Success [state (|> expected_package @@ -149,21 +153,21 @@ (\ xml.codec encode) (\ utf8.codec encode))]) - (text.ends_with? pom_sha1 uri) + (text.ends_with? ..pom_sha-1 uri) (#try.Success [state (|> dummy_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ utf8.codec encode) - sha1)]) + ..sha-1)]) - (text.ends_with? pom_md5 uri) + (text.ends_with? ..pom_md5 uri) (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ utf8.codec encode) - md5)]) + ..md5)]) ## else (#try.Failure "NOPE")) @@ -172,7 +176,7 @@ (#try.Failure "NOPE")))) (def: (bad_md5 expected_artifact expected_package dummy_package) - (-> Artifact Package Package (Simulation Any)) + (-> Artifact Package Package (Mock Any)) (implementation (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) @@ -181,17 +185,17 @@ (get@ #///package.library) product.left)]) - (text.ends_with? lux_sha1 uri) + (text.ends_with? ..lux_sha-1 uri) (#try.Success [state (|> expected_package (get@ #///package.library) product.left - sha1)]) + ..sha-1)]) - (text.ends_with? lux_md5 uri) + (text.ends_with? ..lux_md5 uri) (#try.Success [state (|> dummy_package (get@ #///package.library) product.left - md5)]) + ..md5)]) (text.ends_with? ///artifact/extension.pom uri) (#try.Success [state (|> expected_package @@ -200,21 +204,21 @@ (\ xml.codec encode) (\ utf8.codec encode))]) - (text.ends_with? pom_sha1 uri) + (text.ends_with? ..pom_sha-1 uri) (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ utf8.codec encode) - sha1)]) + ..sha-1)]) - (text.ends_with? pom_md5 uri) + (text.ends_with? ..pom_md5 uri) (#try.Success [state (|> dummy_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ utf8.codec encode) - md5)]) + ..md5)]) ## else (#try.Failure "NOPE")) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index 86771cf1f..0241b27a9 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." binary] ["." text @@ -58,7 +56,7 @@ //format.profile %.code (\ utf8.codec encode) - (!.use (\ file over_write))) + (\ file over_write)) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] (wrap (\ //.equivalence = diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index 132c51b38..56daf3cad 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -26,15 +26,16 @@ [world ["." file]]] [// - ["@." profile] + ["$." profile] [// [lux [data - ["_." binary]]]]] + ["$." binary]]]]] {#program ["." / ["/#" // #_ ["#" profile] + ["#." hash ("#\." equivalence)] ["#." pom] [dependency ["#." status]] @@ -45,13 +46,13 @@ (Random [//.Profile /.Package]) (do {! random.monad} [content_size (\ ! map (n.% 100) random.nat) - content (_binary.random content_size) + content ($binary.random content_size) [profile pom] (random.one (function (_ profile) (try.to_maybe (do try.monad [pom (//pom.write profile)] (wrap [profile pom])))) - @profile.random)] + $profile.random)] (wrap [profile (/.local pom content)]))) (def: #export test @@ -79,19 +80,31 @@ (and (case (get@ #/.origin local) (#//origin.Local "") true _ false) - (and (is? expected_library actual_library) - (case library_status - #//status.Unverified true - _ false)) - (and (is? expected_pom actual_pom) - (|> (do try.monad - [xml_pom (\ utf8.codec decode binary_pom) - decoded_pom (\ xml.codec decode xml_pom)] - (wrap (\ xml.equivalence = actual_pom decoded_pom))) - (try.default false)) - (case pom_status - #//status.Unverified true - _ false))))) + (let [expected_sha1 (//hash.sha-1 expected_library) + expected_md5 (//hash.md5 expected_library)] + (and (is? expected_library actual_library) + (case library_status + (#//status.Verified actual_sha1 expected_md5) + (and (//hash\= expected_sha1 actual_sha1) + (//hash\= expected_md5 expected_md5)) + + _ + false))) + (let [expected_sha1 (//hash.sha-1 binary_pom) + expected_md5 (//hash.md5 binary_pom)] + (and (is? expected_pom actual_pom) + (|> (do try.monad + [xml_pom (\ utf8.codec decode binary_pom) + decoded_pom (\ xml.codec decode xml_pom)] + (wrap (\ xml.equivalence = actual_pom decoded_pom))) + (try.default false)) + (case pom_status + (#//status.Verified actual_sha1 expected_md5) + (and (//hash\= expected_sha1 actual_sha1) + (//hash\= expected_md5 expected_md5)) + + _ + false)))))) (_.cover [/.dependencies] (let [expected (get@ #//.dependencies profile)] (case (/.dependencies package) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index ed32f0ac3..98d869b5b 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -24,13 +24,14 @@ ["." / #_ ["#." identity] ["#." origin] + ["#." remote] [// ["@." artifact]]] {#spec ["$." /]} {#program ["." / - ["#." remote] + ["." remote] ["/#" // #_ ["#." artifact (#+ Version Artifact) ["#/." extension (#+ Extension)]]]]}) @@ -62,8 +63,8 @@ Version "4.5.6-NO") -(implementation: #export simulation - (/.Simulation Store) +(implementation: #export mock + (/.Mock Store) (def: (on_download uri state) (case (dictionary.get uri state) @@ -83,18 +84,19 @@ Test (<| (_.covering /._) ($_ _.and - (_.for [/.mock /.Simulation] + (_.for [/.mock /.Mock] (do random.monad [_ (wrap [])] ($/.spec (..artifact ..valid_version) (..artifact ..invalid_version) - (/.mock ..simulation + (/.mock ..mock (|> ..empty - (dictionary.put (/remote.uri ..invalid_version - (..artifact ..invalid_version) - //artifact/extension.lux_library) + (dictionary.put (remote.uri ..invalid_version + (..artifact ..invalid_version) + //artifact/extension.lux_library) (binary.create 0))))))) /identity.test /origin.test + /remote.test ))) diff --git a/stdlib/source/test/aedifex/repository/remote.lux b/stdlib/source/test/aedifex/repository/remote.lux new file mode 100644 index 000000000..f488391ce --- /dev/null +++ b/stdlib/source/test/aedifex/repository/remote.lux @@ -0,0 +1,130 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try ("#\." monad)] + ["." exception] + ["." function]] + [data + ["." binary ("#\." equivalence)] + ["." maybe ("#\." functor)] + ["." text ("#\." equivalence) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." dictionary]]] + [math + ["." random (#+ Random)]] + [world + [net (#+ URL) + ["." http #_ + ["#" client] + ["#/." status] + ["@#" /]]]]] + {#program + ["." / + ["/#" // #_ + ["#." identity]]]}) + +(def: (url_body url) + (-> URL (@http.Body IO)) + (let [url (\ utf8.codec encode url)] + (function (_ _) + (io.io (#try.Success [(binary.size url) url]))))) + +(def: (good_http user password) + (-> //identity.User //identity.Password (http.Client IO)) + (implementation + (def: (request method url headers input) + (with_expansions [<failure> [http/status.bad_request + {#@http.headers (http.headers (list)) + #@http.body (..url_body "")}]] + (<| io.io + #try.Success + (if (|> headers + (dictionary.get "User-Agent") + (maybe\map (is? /.user_agent)) + (maybe.default false)) + (case [method input] + [#@http.Get #.None] + [http/status.ok + {#@http.headers (http.headers (list)) + #@http.body (..url_body url)}] + + [#@http.Put (#.Some input)] + (if (|> headers + (dictionary.get "Authorization") + (maybe\map (text\= (//identity.basic_auth user password))) + (maybe.default false)) + [http/status.created + {#@http.headers (http.headers (list)) + #@http.body (..url_body url)}] + <failure>) + + _ + <failure>) + <failure>)))))) + +(def: bad_http + (http.Client IO) + (implementation + (def: (request method url headers input) + (<| io.io + #try.Success + [http/status.bad_request + {#@http.headers (http.headers (list)) + #@http.body (..url_body "")}])))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [address (random.ascii/upper 10) + uri (random.ascii/lower 10) + + user (random.ascii/lower 10) + password (random.ascii/lower 10) + + content (\ ! map (\ utf8.codec encode) + (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.repository /.user_agent /.Address] + (let [repo (/.repository (..good_http user password) + (#.Some {#//identity.user user + #//identity.password password}) + address)] + (and (|> (\ repo download uri) + io.run + (try\map (\ utf8.codec decode)) + try\join + (try\map (text\= (format address uri))) + (try.default false)) + (|> (\ repo upload uri content) + io.run + (try\map (function.constant true)) + (try.default false))))) + (_.cover [/.upload_failure] + (let [repo (/.repository (..good_http user password) + #.None + address)] + (case (io.run (\ repo upload uri content)) + (#try.Failure error) + (exception.match? /.upload_failure error) + + (#try.Success _) + false))) + (_.cover [/.download_failure] + (let [repo (/.repository ..bad_http + #.None + address)] + (case (io.run (\ repo download uri)) + (#try.Failure error) + (exception.match? /.download_failure error) + + (#try.Success _) + false))) + )))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index c4c0657e7..ef0454553 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -9,9 +9,6 @@ ["$." functor (#+ Injection Comparison)] ["$." apply] ["$." monad]]}] - [control - [security - ["!" capability]]] [data ["." text ("#\." equivalence)]] [math @@ -24,14 +21,14 @@ (def: (injection can_conceal) (All [label] (-> (Can_Conceal label) (Injection (All [value] (Private value label))))) - (!.use can_conceal)) + can_conceal) (def: (comparison can_reveal) (All [label] (-> (Can_Reveal label) (Comparison (All [value] (Private value label))))) (function (_ == left right) - (== (!.use can_reveal left) - (!.use can_reveal right)))) + (== (can_reveal left) + (can_reveal right)))) (type: Password (Private Text)) @@ -56,14 +53,14 @@ (def: &equivalence (implementation (def: (= reference sample) - (text\= (!.use %\can_downgrade reference) - (!.use %\can_downgrade sample))))) + (text\= (%\can_downgrade reference) + (%\can_downgrade sample))))) (def: hash - (|>> (!.use %\can_downgrade) + (|>> %\can_downgrade (\ text.hash hash))))) (def: password - (!.use %\can_upgrade)) + %\can_upgrade) (def: privilege privilege)))))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 47e4ceb27..c5ea26a6f 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -13,7 +13,8 @@ ["#/." resolution]]] ["#." net #_ ["#/." http #_ - ["#/." client]]]]) + ["#/." client] + ["#/." status]]]]) (def: #export test Test @@ -25,4 +26,5 @@ /input/keyboard.test /output/video/resolution.test /net/http/client.test + /net/http/status.test )) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index 56e3902f0..b196199fc 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -6,9 +6,7 @@ [control ["." io] ["." try (#+ Try)] - ["." exception (#+ exception:)] - [security - ["!" capability]]] + ["." exception (#+ exception:)]] [data ["." text ("#\." equivalence) ["%" format (#+ format)]]] @@ -21,8 +19,8 @@ (exception: dead) -(def: simulation - (/.Simulation [Bit Text]) +(def: mock + (/.Mock [Bit Text]) (implementation (def: (on_read [dead? content]) (do try.monad @@ -53,16 +51,16 @@ Test (<| (_.covering /._) ($_ _.and - (_.for [/.async /.mock /.Simulation] - ($/.spec (io.io (/.async (/.mock ..simulation [false ""]))))) + (_.for [/.async /.mock /.Mock] + ($/.spec (io.io (/.async (/.mock ..mock [false ""]))))) (do random.monad [expected (random.ascii/alpha 10) - #let [console (/.mock ..simulation [false ""])]] + #let [console (/.mock ..mock [false ""])]] (_.cover [/.write_line] (io.run (do io.monad [?_ (/.write_line expected console) - ?actual (!.use (\ console read_line) [])] + ?actual (\ console read_line [])] (wrap (<| (try.default false) (do try.monad [_ ?_ diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index c7f546a1b..8a0c416be 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -7,9 +7,7 @@ ["." io (#+ IO)] ["." try (#+ Try)] [concurrency - ["." promise]] - [security - ["!" capability]]] + ["." promise]]] [data ["." binary (#+ Binary)] ["." text] @@ -72,7 +70,7 @@ (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) (do {! random.monad} [file_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) dataL (_binary.random file_size) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index c0873b41a..9c1b31811 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -8,9 +8,7 @@ ["." try] ["." exception] [concurrency - ["." promise]] - [security - ["!" capability]]] + ["." promise]]] [data ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) @@ -106,12 +104,12 @@ data (_binary.random 10)] (wrap (do {! promise.monad} [verdict (do (try.with !) - [_ (!.use (\ fs create_directory) [directory]) + [_ (\ fs create_directory directory) _ (\ watcher start /.all directory) poll/0 (\ watcher poll []) #let [no_events_prior_to_creation! (list.empty? poll/0)] - file (!.use (\ fs create_file) [expected_path]) + file (\ fs create_file expected_path) poll/1 (\ watcher poll []) poll/1' (\ watcher poll []) #let [after_creation! @@ -126,7 +124,7 @@ false) (list.empty? poll/1'))] _ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) - _ (!.use (\ file over_write) data) + _ (\ file over_write data) poll/2 (\ watcher poll []) poll/2' (\ watcher poll []) #let [after_modification! @@ -140,7 +138,7 @@ _ false) (list.empty? poll/2'))] - _ (!.use (\ file delete) []) + _ (\ file delete []) poll/3 (\ watcher poll []) poll/3' (\ watcher poll []) #let [after_deletion! diff --git a/stdlib/source/test/lux/world/net/http/status.lux b/stdlib/source/test/lux/world/net/http/status.lux new file mode 100644 index 000000000..801dc1b43 --- /dev/null +++ b/stdlib/source/test/lux/world/net/http/status.lux @@ -0,0 +1,119 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [data + [collection + ["." list] + ["." set (#+ Set)]]] + [macro + ["." template]] + [math + [number + ["n" nat]]]] + {1 + ["." / + ["/#" //]]}) + +(with_expansions [<categories> (as_is [informational + [/.continue + /.switching_protocols + /.processing + /.early_hints]] + [success + [/.ok + /.created + /.accepted + /.non_authoritative_information + /.no_content + /.reset_content + /.partial_content + /.multi_status + /.already_reported + /.im_used]] + [redirection + [/.multiple_choices + /.moved_permanently + /.found + /.see_other + /.not_modified + /.use_proxy + /.switch_proxy + /.temporary_redirect + /.permanent_redirect]] + [client + [/.bad_request + /.unauthorized + /.payment_required + /.forbidden + /.not_found + /.method_not_allowed + /.not_acceptable + /.proxy_authentication_required + /.request_timeout + /.conflict + /.gone + /.length_required + /.precondition_failed + /.payload_too_large + /.uri_too_long + /.unsupported_media_type + /.range_not_satisfiable + /.expectation_failed + /.im_a_teapot + /.misdirected_request + /.unprocessable_entity + /.locked + /.failed_dependency + /.upgrade_required + /.precondition_required + /.too_many_requests + /.request_header_fields_too_large + /.unavailable_for_legal_reasons]] + [server + [/.internal_server_error + /.not_implemented + /.bad_gateway + /.service_unavailable + /.gateway_timeout + /.http_version_not_supported + /.variant_also_negotiates + /.insufficient_storage + /.loop_detected + /.not_extended + /.network_authentication_required]])] + (def: all + (List //.Status) + (list.concat (`` (list (~~ (template [<category> <status+>] + [((: (-> Any (List //.Status)) + (function (_ _) + (`` (list (~~ (template.splice <status+>)))))) + 123)] + + <categories>)))))) + + (def: unique + (Set //.Status) + (set.from_list n.hash ..all)) + + (def: verdict + (n.= (list.size ..all) + (set.size ..unique))) + + (template [<category> <status+>] + [(def: <category> + Test + (_.cover <status+> + ..verdict))] + + <categories>) + + (def: #export test + Test + (<| (_.covering /._) + (`` ($_ _.and + (~~ (template [<category> <status+>] + [<category>] + + <categories>)) + )))) + ) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 334250a96..64fa47d28 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -1,7 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." debug] [abstract [monad (#+ do)]] [control @@ -10,8 +9,6 @@ ["." io (#+ IO)] [concurrency ["." promise (#+ Promise)]] - [security - ["!" capability]] [parser ["." environment (#+ Environment)]]] [data @@ -32,9 +29,9 @@ (exception: dead) -(def: (simulation [environment working_directory command arguments]) +(def: (mock [environment working_directory command arguments]) (-> [Environment Path /.Command (List /.Argument)] - (/.Simulation Bit)) + (/.Mock Bit)) (implementation (def: (on_read dead?) (if dead? @@ -66,40 +63,28 @@ (def: (io_shell command oops input destruction exit) (-> /.Command Text Text Text /.Exit (/.Shell IO)) (implementation - (def: execute - ((debug.private /.can_execute) - (function (_ [environment working_directory command arguments]) - (io.io - (#try.Success - (: (/.Process IO) - (implementation - (def: read - ((debug.private /.can_read) - (function (_ _) - (io.io (#try.Success command))))) - (def: error - ((debug.private /.can_read) - (function (_ _) - (io.io (#try.Success oops))))) - (def: write - ((debug.private /.can_write) - (function (_ message) - (io.io (#try.Failure message))))) - (def: destroy - ((debug.private /.can_destroy) - (function (_ _) - (io.io (#try.Failure destruction))))) - (def: await - ((debug.private /.can_wait) - (function (_ _) - (io.io (#try.Success exit)))))))))))))) + (def: (execute [environment working_directory command arguments]) + (<| io.io + #try.Success + (: (/.Process IO)) + (implementation + (def: (read _) + (io.io (#try.Success command))) + (def: (error _) + (io.io (#try.Success oops))) + (def: (write message) + (io.io (#try.Failure message))) + (def: (destroy _) + (io.io (#try.Failure destruction))) + (def: (await _) + (io.io (#try.Success exit)))))))) (def: #export test Test (<| (_.covering /._) ($_ _.and - (_.for [/.async /.mock /.Simulation] - ($/.spec (/.async (/.mock (|>> ..simulation #try.Success) + (_.for [/.async /.mock /.Mock] + ($/.spec (/.async (/.mock (|>> ..mock #try.Success) false)))) (_.cover [/.error] (not (i.= /.normal /.error))) @@ -112,11 +97,11 @@ #let [shell (/.async (..io_shell command oops input destruction exit))]] (wrap (do {! promise.monad} [verdict (do (try.with !) - [process (!.use (\ shell execute) [environment.empty "~" command (list)]) - read (!.use (\ process read) []) - error (!.use (\ process error) []) + [process (\ shell execute [environment.empty "~" command (list)]) + read (\ process read []) + error (\ process error []) wrote! (do ! - [write (!.use (\ process write) [input])] + [write (\ process write input)] (wrap (#try.Success (case write (#try.Success _) false @@ -124,19 +109,19 @@ (#try.Failure write) (text\= input write))))) destroyed! (do ! - [destroy (!.use (\ process destroy) [])] + [destroy (\ process destroy [])] (wrap (#try.Success (case destroy (#try.Success _) false (#try.Failure destroy) (text\= destruction destroy))))) - await (!.use (\ process await) [])] + await (\ process await [])] (wrap (and (text\= command read) (text\= oops error) wrote! destroyed! (i.= exit await))))] - (_.cover' [/.Can_Write] + (_.cover' [/.Shell] (try.default false verdict))))) ))) |