diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/world/console.lux | 96 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file.lux | 602 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file/watch.lux | 152 | ||||
| -rw-r--r-- | stdlib/source/lux/world/program.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/lux/world/shell.lux | 192 |
5 files changed, 532 insertions, 532 deletions
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 8c074c4d8..68e1d056f 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -21,27 +21,27 @@ [(exception: #export (<name>) "")] - [cannot-open] - [cannot-close] + [cannot_open] + [cannot_close] ) -(capability: #export (Can-Read ! o) - (can-read [] (! (Try o)))) +(capability: #export (Can_Read ! o) + (can_read [] (! (Try o)))) -(capability: #export (Can-Write ! i) - (can-write i (! (Try Any)))) +(capability: #export (Can_Write ! i) + (can_write i (! (Try Any)))) -(capability: #export (Can-Close !) - (can-close [] (! (Try Any)))) +(capability: #export (Can_Close !) + (can_close [] (! (Try Any)))) (signature: #export (Console !) - (: (Can-Read ! Char) + (: (Can_Read ! Char) read) - (: (Can-Read ! Text) - read-line) - (: (Can-Write ! Text) + (: (Can_Read ! Text) + read_line) + (: (Can_Write ! Text) write) - (: (Can-Close !) + (: (Can_Close !) close)) (def: #export (async console) @@ -51,12 +51,12 @@ (<forge> (|>> (!.use (\ console <capability>)) promise.future)))] - [read ..can-read] - [read-line ..can-read] - [write ..can-write] - [close ..can-close]))))) + [read ..can_read] + [read_line ..can_read] + [write ..can_write] + [close ..can_close]))))) -(with-expansions [<jvm> (as-is (import: java/lang/String) +(with_expansions [<jvm> (as_is (import: java/lang/String) (import: java/io/Console ["#::." @@ -79,54 +79,54 @@ (def: #export default (IO (Try (Console IO))) (do io.monad - [?jvm-console (java/lang/System::console)] - (case ?jvm-console + [?jvm_console (java/lang/System::console)] + (case ?jvm_console #.None - (wrap (exception.throw ..cannot-open [])) + (wrap (exception.throw ..cannot_open [])) - (#.Some jvm-console) - (let [jvm-input (java/lang/System::in) - jvm-output (java/lang/System::out)] + (#.Some jvm_console) + (let [jvm_input (java/lang/System::in) + jvm_output (java/lang/System::out)] (<| wrap exception.return (: (Console IO)) ## TODO: Remove ASAP (structure (def: read - (..can-read + (..can_read (function (_ _) - (|> jvm-input + (|> jvm_input java/io/InputStream::read (\ (try.with io.monad) map .nat))))) - (def: read-line - (..can-read + (def: read_line + (..can_read (function (_ _) - (java/io/Console::readLine jvm-console)))) + (java/io/Console::readLine jvm_console)))) (def: write - (..can-write + (..can_write (function (_ message) - (java/io/PrintStream::print message jvm-output)))) + (java/io/PrintStream::print message jvm_output)))) (def: close - (..can-close - (|>> (exception.throw ..cannot-close) wrap))))))))))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (..can_close + (|>> (exception.throw ..cannot_close) wrap))))))))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) -(def: #export (write-line message console) +(def: #export (write_line message console) (All [!] (-> Text (Console !) (! (Try Any)))) - (!.use (\ console write) [(format message text.new-line)])) + (!.use (\ console write) [(format message text.new_line)])) (signature: #export (Simulation s) (: (-> s (Try [s Char])) - on-read) + on_read) (: (-> s (Try [s Text])) - on-read-line) + on_read_line) (: (-> Text s (Try s)) - on-write) + on_write) (: (-> s (Try s)) - on-close)) + on_close)) (def: #export (mock simulation init) (All [s] (-> (Simulation s) s (Console Promise))) @@ -134,7 +134,7 @@ (`` (structure (~~ (template [<method> <simulation>] [(def: <method> - (..can-read + (..can_read (function (_ _) (stm.commit (do {! stm.monad} @@ -148,17 +148,17 @@ (#try.Failure error) (wrap (#try.Failure error))))))))] - [read on-read] - [read-line on-read-line] + [read on_read] + [read_line on_read_line] )) (def: write - (..can-write + (..can_write (function (_ input) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-write input |state|) + (case (\ simulation on_write input |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -168,12 +168,12 @@ (wrap (#try.Failure error)))))))) (def: close - (..can-close + (..can_close (function (_ _) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-close |state|) + (case (\ simulation on_close |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 3a4359f6f..db973ece4 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -36,24 +36,24 @@ (type: #export Path Text) -(capability: #export (Can-Open ! capability) - (can-open Path (! (Try (capability !))))) +(capability: #export (Can_Open ! capability) + (can_open Path (! (Try (capability !))))) -(capability: #export (Can-See o) - (can-see [] o)) +(capability: #export (Can_See o) + (can_see [] o)) -(capability: #export (Can-Query ! o) - (can-query [] (! (Try o)))) +(capability: #export (Can_Query ! o) + (can_query [] (! (Try o)))) -(capability: #export (Can-Modify ! i) - (can-modify [i] (! (Try Any)))) +(capability: #export (Can_Modify ! i) + (can_modify [i] (! (Try Any)))) -(capability: #export (Can-Delete !) - (can-delete [] (! (Try Any)))) +(capability: #export (Can_Delete !) + (can_delete [] (! (Try Any)))) (`` (signature: #export (File !) (~~ (template [<name> <output>] - [(: (Can-See <output>) + [(: (Can_See <output>) <name>)] [name Text] @@ -61,135 +61,135 @@ )) (~~ (template [<name> <output>] - [(: (Can-Query ! <output>) + [(: (Can_Query ! <output>) <name>)] [size Nat] - [last-modified Instant] - [can-execute? Bit] + [last_modified Instant] + [can_execute? Bit] [content Binary] )) - (: (Can-Open ! File) + (: (Can_Open ! File) move) (~~ (template [<name> <input>] - [(: (Can-Modify ! <input>) + [(: (Can_Modify ! <input>) <name>)] [modify Instant] - [over-write Binary] + [over_write Binary] [append Binary] )) - (: (Can-Delete !) + (: (Can_Delete !) delete) )) (signature: #export (Directory !) - (: (Can-See Path) + (: (Can_See Path) scope) - (: (Can-Query ! (List (File !))) + (: (Can_Query ! (List (File !))) files) - (: (Can-Query ! (List (Directory !))) + (: (Can_Query ! (List (Directory !))) directories) - (: (Can-Delete !) + (: (Can_Delete !) discard)) (`` (signature: #export (System !) (~~ (template [<name> <capability>] - [(: (Can-Open ! <capability>) + [(: (Can_Open ! <capability>) <name>)] [file File] - [create-file File] + [create_file File] [directory Directory] - [create-directory Directory] + [create_directory Directory] )) (: Text separator) )) -(def: (async-file file) +(def: (async_file file) (-> (File IO) (File Promise)) (`` (structure (~~ (template [<forge> <name>+] - [(with-expansions [<rows> (template.splice <name>+)] + [(with_expansions [<rows> (template.splice <name>+)] (template [<name>] [(def: <name> (<forge> (|>> (!.use (\ file <name>)))))] <rows>))] - [..can-see + [..can_see [[name] [path]]] )) (~~ (template [<forge> <name>+] - [(with-expansions [<rows> (template.splice <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_query + [[size] [last_modified] [can_execute?] [content]]] - [..can-modify - [[modify] [over-write] [append]]] + [..can_modify + [[modify] [over_write] [append]]] - [..can-delete + [..can_delete [[delete]]])) (def: move - (..can-open - (|>> (!.use (\ file move)) (io\map (try\map async-file)) promise.future)))))) + (..can_open + (|>> (!.use (\ file move)) (io\map (try\map async_file)) promise.future)))))) -(def: (async-directory directory) +(def: (async_directory directory) (-> (Directory IO) (Directory Promise)) (`` (structure (def: scope (\ directory scope)) (~~ (template [<name> <async>] [(def: <name> - (..can-query + (..can_query (|>> (!.use (\ directory <name>)) (io\map (try\map (list\map <async>))) promise.future)))] - [files ..async-file] - [directories async-directory])) + [files ..async_file] + [directories async_directory])) (def: discard - (..can-delete + (..can_delete (|>> (!.use (\ directory discard)) promise.future)))))) (def: #export (async system) (-> (System IO) (System Promise)) (`` (structure (~~ (template [<name> <async>] - [(def: <name> (..can-open + [(def: <name> (..can_open (|>> (!.use (\ system <name>)) (io\map (try\map <async>)) promise.future)))] - [file ..async-file] - [create-file ..async-file] - [directory ..async-directory] - [create-directory ..async-directory])) + [file ..async_file] + [create_file ..async_file] + [directory ..async_directory] + [create_directory ..async_directory])) (def: separator (\ system separator))))) -(def: #export (un-nest system file) +(def: #export (un_nest system file) (All [!] (-> (System !) Path (Maybe [Path Text]))) - (case (text.last-index-of (\ system separator) file) + (case (text.last_index_of (\ system separator) file) #.None #.None - (#.Some last-separator) - (let [[parent temp] (maybe.assume (text.split last-separator file)) + (#.Some last_separator) + (let [[parent temp] (maybe.assume (text.split last_separator file)) [_ child] (maybe.assume (text.split (text.size (\ system separator)) temp))] (#.Some [parent child])))) @@ -202,25 +202,25 @@ (exception.report ["Path" file]))] - [cannot-create-file] - [cannot-find-file] - [cannot-delete-file] - [not-a-file] + [cannot_create_file] + [cannot_find_file] + [cannot_delete_file] + [not_a_file] - [cannot-create-directory] - [cannot-find-directory] - [cannot-discard-directory] + [cannot_create_directory] + [cannot_find_directory] + [cannot_discard_directory] - [cannot-read-all-data] - [not-a-directory] + [cannot_read_all_data] + [not_a_directory] ) -(with-expansions [<for-jvm> (as-is (exception: #export (cannot-move {target Path} {source Path}) +(with_expansions [<for_jvm> (as_is (exception: #export (cannot_move {target Path} {source Path}) (exception.report ["Source" source] ["Target" target])) - (exception: #export (cannot-modify {instant Instant} {file Path}) + (exception: #export (cannot_modify {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] ["Path" file])) @@ -283,7 +283,7 @@ (~~ (template [<name> <flag>] [(def: <name> - (..can-modify + (..can_modify (function (<name> data) (do (try.with io.monad) [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>) @@ -291,61 +291,61 @@ _ (java/io/OutputStream::flush stream)] (java/lang/AutoCloseable::close stream)))))] - [over-write #0] + [over_write #0] [append #1] )) (def: content - (..can-query + (..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) + bytes_read (java/io/InputStream::read data stream) _ (java/lang/AutoCloseable::close stream)] - (if (i.= size bytes-read) + (if (i.= size bytes_read) (wrap data) - (\ io.monad wrap (exception.throw ..cannot-read-all-data path))))))) + (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))))) (def: name - (..can-see + (..can_see (function (name _) (|> path java/io/File::new java/io/File::getName)))) (def: path - (..can-see + (..can_see (function (_ _) path))) (def: size - (..can-query + (..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 _) + (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)))))) + (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))))) - (def: can-execute? - (..can-query - (function (can-execute? _) + (def: can_execute? + (..can_query + (function (can_execute? _) (|> path java/io/File::new java/io/File::canExecute)))) (def: move - (..can-open + (..can_open (function (move destination) (do io.monad [outcome (java/io/File::renameTo (java/io/File::new destination) @@ -355,66 +355,66 @@ (wrap (#try.Success (file destination))) _ - (wrap (exception.throw ..cannot-move [destination path]))))))) + (wrap (exception.throw ..cannot_move [destination path]))))))) (def: modify - (..can-modify - (function (modify time-stamp) + (..can_modify + (function (modify time_stamp) (do io.monad - [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) + [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]))))))) + (wrap (exception.throw ..cannot_modify [time_stamp path]))))))) (def: delete - (..can-delete + (..can_delete (function (delete _) - (!delete path cannot-delete-file)))))) + (!delete path cannot_delete_file)))))) (`` (structure: (directory path) (-> Path (Directory IO)) (def: scope - (..can-see + (..can_see (function (_ _) path))) (~~ (template [<name> <method> <capability>] [(def: <name> - (..can-query + (..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 + 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])))))))] + (\ 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 + (..can_delete (function (discard _) - (!delete path cannot-discard-directory)))))) + (!delete path cannot_discard_directory)))))) (`` (structure: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] [(def: <name> - (..can-open + (..can_open (function (<name> path) (do io.monad [#let [file (java/io/File::new path)] @@ -426,22 +426,22 @@ _ (wrap (exception.throw <exception> [path])))))))] - [file java/io/File::isFile ..file cannot-find-file] - [create-file java/io/File::createNewFile ..file cannot-create-file] - [directory java/io/File::isDirectory ..directory cannot-find-directory] - [create-directory java/io/File::mkdir ..directory cannot-create-directory] + [file java/io/File::isFile ..file cannot_find_file] + [create_file java/io/File::createNewFile ..file cannot_create_file] + [directory java/io/File::isDirectory ..directory cannot_find_directory] + [create_directory java/io/File::mkdir ..directory cannot_create_directory] )) (def: separator (java/io/File::separator)) )))] (for {@.old - (as-is <for-jvm>) + (as_is <for_jvm>) @.jvm - (as-is <for-jvm>) + (as_is <for_jvm>) @.js - (as-is (import: Buffer + (as_is (import: Buffer (#static from [Binary] ..Buffer)) (import: FileDescriptor) @@ -481,14 +481,14 @@ (-> [] (Maybe (-> host.String Any))) (host.constant (-> host.String Any) <path>))] - [normal-require [require]] - [global-require [global require]] - [process-load [global process mainModule constructor _load]] + [normal_require [require]] + [global_require [global require]] + [process_load [global process mainModule constructor _load]] ) (def: (require _) (-> [] (-> host.String Any)) - (case [(normal-require []) (global-require []) (process-load [])] + (case [(normal_require []) (global_require []) (process_load [])] (^or [(#.Some require) _ _] [_ (#.Some require) _] [_ _ (#.Some require)]) @@ -502,8 +502,8 @@ (-> [] <type>) (:coerce <type> (..require [] <module>)))] - [node-fs "fs" ..Fs] - [node-path "path" ..JsPath] + [node_fs "fs" ..Fs] + [node_path "path" ..JsPath] ) (`` (structure: (file path) @@ -511,57 +511,57 @@ (~~ (template [<name> <method>] [(def: <name> - (..can-modify + (..can_modify (function (<name> data) - (<method> [path (Buffer::from data)] (..node-fs [])))))] + (<method> [path (Buffer::from data)] (..node_fs [])))))] - [over-write Fs::writeFileSync] + [over_write Fs::writeFileSync] [append Fs::appendFileSync] )) (def: content - (..can-query + (..can_query (function (_ _) - (Fs::readFileSync [path] (..node-fs []))))) + (Fs::readFileSync [path] (..node_fs []))))) (def: name - (..can-see + (..can_see (function (_ _) - (JsPath::basename path (..node-path []))))) + (JsPath::basename path (..node_path []))))) (def: path - (..can-see + (..can_see (function (_ _) path))) (def: size - (..can-query + (..can_query (function (_ _) (do (try.with io.monad) - [stat (Fs::statSync [path] (..node-fs []))] + [stat (Fs::statSync [path] (..node_fs []))] (wrap (|> stat Stats::size f.nat)))))) - (def: last-modified - (..can-query + (def: last_modified + (..can_query (function (_ _) (do (try.with io.monad) - [stat (Fs::statSync [path] (..node-fs []))] + [stat (Fs::statSync [path] (..node_fs []))] (wrap (|> stat Stats::mtimeMs f.int - duration.from-millis + duration.from_millis instant.absolute)))))) - (def: can-execute? - (..can-query - (function (can-execute? _) + (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)] + [#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)] + [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)] (wrap (#try.Success (case outcome (#try.Success _) true @@ -570,44 +570,44 @@ false)))))))) (def: move - (..can-open + (..can_open (function (move destination) (do (try.with io.monad) - [_ (Fs::renameSync [path destination] (..node-fs []))] + [_ (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 [])))))) + (..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 + (..can_delete (function (delete _) - (Fs::unlink [path] (..node-fs []))))))) + (Fs::unlink [path] (..node_fs []))))))) (`` (structure: (directory path) (-> Path (Directory IO)) (def: scope - (..can-see + (..can_see (function (_ _) path))) (~~ (template [<name> <method> <capability>] [(def: <name> - (..can-query + (..can_query (function (<name> _) (do {! (try.with io.monad)} - [#let [node-fs (..node-fs [])] - subs (Fs::readdirSync [path] node-fs) + [#let [node_fs (..node_fs [])] + subs (Fs::readdirSync [path] node_fs) subs (monad.map ! (function (_ sub) (do ! - [stats (Fs::statSync [sub] node-fs) + [stats (Fs::statSync [sub] node_fs) verdict (<method> [] stats)] (wrap [verdict sub]))) - (array.to-list subs))] + (array.to_list subs))] (wrap (|> subs (list.filter product.left) (list\map (|>> product.right <capability>))))))))] @@ -617,51 +617,51 @@ )) (def: discard - (..can-delete + (..can_delete (function (discard _) - (Fs::rmdirSync [path] (..node-fs []))))))) + (Fs::rmdirSync [path] (..node_fs []))))))) (`` (structure: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] [(def: <name> - (..can-open + (..can_open (function (<name> path) (do (try.with io.monad) - [stats (Fs::statSync [path] (..node-fs [])) + [stats (Fs::statSync [path] (..node_fs [])) verdict (<method> [] stats)] (if verdict (wrap (<capability> path)) (\ io.monad wrap (exception.throw <exception> [path])))))))] - [file Stats::isFile ..file ..cannot-find-file] - [directory Stats::isDirectory ..directory ..cannot-find-directory] + [file Stats::isFile ..file ..cannot_find_file] + [directory Stats::isDirectory ..directory ..cannot_find_directory] )) (~~ (template [<name> <capability> <exception> <prep>] [(def: <name> - (..can-open + (..can_open (function (<name> path) - (let [node-fs (..node-fs [])] + (let [node_fs (..node_fs [])] (do io.monad - [outcome (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] + [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>)] + [_ (|> 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])] + [create_file ..file ..cannot_create_file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])] + [create_directory ..directory ..cannot_create_directory (Fs::mkdirSync [path])] )) (def: separator - (if host.on-node-js? - (JsPath::sep (..node-path [])) + (if host.on_node_js? + (JsPath::sep (..node_path [])) "/")) )) ) @@ -681,8 +681,8 @@ (!.use (\ system <create>) path) (wrap (#try.Failure error))))))] - [get-file File create-file file ..cannot-find-file] - [get-directory Directory create-directory directory ..cannot-find-directory] + [get_file File create_file file ..cannot_find_file] + [get_directory Directory create_directory directory ..cannot_find_directory] ) (template [<predicate> <capability>] @@ -697,34 +697,34 @@ (#try.Failure _) (wrap false))))] - [file-exists? file] - [directory-exists? directory] + [file_exists? file] + [directory_exists? directory] ) (def: #export (exists? monad system path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [verdict (..file-exists? monad system path)] + [verdict (..file_exists? monad system path)] (if verdict (wrap verdict) - (..directory-exists? monad system path)))) + (..directory_exists? monad system path)))) -(type: Mock-File - {#mock-last-modified Instant - #mock-can-execute Bit - #mock-content Binary}) +(type: Mock_File + {#mock_last_modified Instant + #mock_can_execute Bit + #mock_content Binary}) (type: #rec Mock - (Dictionary Text (Either Mock-File Mock))) + (Dictionary Text (Either Mock_File Mock))) -(def: empty-mock +(def: empty_mock Mock (dictionary.new text.hash)) -(def: (create-mock-file! separator path now mock) +(def: (create_mock_file! separator path now mock) (-> Text Path Instant Mock (Try [Text Mock])) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) @@ -732,108 +732,108 @@ (case tail #.Nil (#try.Success [head (dictionary.put head - (#.Left {#mock-last-modified now - #mock-can-execute false - #mock-content (binary.create 0)}) + (#.Left {#mock_last_modified now + #mock_can_execute false + #mock_content (binary.create 0)}) directory)]) (#.Cons _) - (exception.throw ..cannot-create-file [path])) + (exception.throw ..cannot_create_file [path])) (#.Some node) (case [node tail] - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [[file-name sub-directory] (recur sub-directory tail)] - (wrap [file-name (dictionary.put head (#.Right sub-directory) directory)])) + [[file_name sub_directory] (recur sub_directory tail)] + (wrap [file_name (dictionary.put head (#.Right sub_directory) directory)])) _ - (exception.throw ..cannot-create-file [path]))) + (exception.throw ..cannot_create_file [path]))) #.Nil - (exception.throw ..cannot-create-file [path])))) + (exception.throw ..cannot_create_file [path])))) -(def: (retrieve-mock-file! separator path mock) - (-> Text Path Mock (Try [Text Mock-File])) +(def: (retrieve_mock_file! separator path mock) + (-> Text Path Mock (Try [Text Mock_File])) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-file [path]) + (exception.throw ..cannot_find_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success [head file]) - [(#.Right sub-directory) (#.Cons _)] - (recur sub-directory tail) + [(#.Right sub_directory) (#.Cons _)] + (recur sub_directory tail) _ - (exception.throw ..cannot-find-file [path]))) + (exception.throw ..cannot_find_file [path]))) #.Nil - (exception.throw ..not-a-file [path])))) + (exception.throw ..not_a_file [path])))) -(def: (update-mock-file! separator path now content mock) +(def: (update_mock_file! separator path now content mock) (-> Text Path Instant Binary Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-file [path]) + (exception.throw ..cannot_find_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success (dictionary.put head (#.Left (|> file - (set@ #mock-last-modified now) - (set@ #mock-content content))) + (set@ #mock_last_modified now) + (set@ #mock_content content))) directory)) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-find-file [path]))) + (exception.throw ..cannot_find_file [path]))) #.Nil - (exception.throw ..cannot-find-file [path])))) + (exception.throw ..cannot_find_file [path])))) -(def: (delete-mock-file! separator path mock) +(def: (delete_mock_file! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-delete-file [path]) + (exception.throw ..cannot_delete_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success (dictionary.remove head directory)) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-delete-file [path]))) + (exception.throw ..cannot_delete_file [path]))) #.Nil - (exception.throw ..cannot-delete-file [path])))) + (exception.throw ..cannot_delete_file [path])))) -(def: (try-update! transform var) +(def: (try_update! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) (do {! stm.monad} [|var| (stm.read var)] @@ -846,109 +846,109 @@ (#try.Failure error) (wrap (#try.Failure error))))) -(def: (mock-file separator name path store) +(def: (mock_file separator name path store) (-> Text Text Path (Var Mock) (File Promise)) (structure (def: name - (..can-see + (..can_see (function.constant name))) (def: path - (..can-see + (..can_see (function.constant path))) (def: size - (..can-query + (..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)))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (binary.size (get@ #mock_content file)))))))))) (def: content - (..can-query + (..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))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_content file))))))))) - (def: last-modified - (..can-query + (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))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_last_modified file))))))))) - (def: can-execute? - (..can-query + (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))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_can_execute file))))))))) - (def: over-write - (..can-modify + (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)))))) + (..try_update! (..update_mock_file! separator path now content) store)))))) (def: append - (..can-modify + (..can_modify (function (_ content) (do promise.monad [now (promise.future instant.now)] (stm.commit - (..try-update! (function (_ |store|) + (..try_update! (function (_ |store|) (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (..update-mock-file! separator path now + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (\ binary.monoid compose - (get@ #mock-content file) + (get@ #mock_content file) content) |store|))) store)))))) (def: modify - (..can-modify + (..can_modify (function (_ now) (stm.commit - (..try-update! (function (_ |store|) + (..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|))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (get@ #mock_content file) |store|))) store))))) (def: delete - (..can-delete + (..can_delete (function (_ _) (stm.commit - (..try-update! (..delete-mock-file! separator path) store))))) + (..try_update! (..delete_mock_file! separator path) store))))) (def: move - (..can-open + (..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 name path store)])) + [[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 name path store)])) (#try.Success [|store| moved]) (do ! [_ (stm.write |store| store)] @@ -958,142 +958,142 @@ (wrap (#try.Failure error)))))))) )) -(def: (create-mock-directory! separator path mock) +(def: (create_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None (case tail #.Nil - (#try.Success (dictionary.put head (#.Right ..empty-mock) directory)) + (#try.Success (dictionary.put head (#.Right ..empty_mock) directory)) (#.Cons _) - (exception.throw ..cannot-create-directory [path])) + (exception.throw ..cannot_create_directory [path])) (#.Some node) (case [node tail] - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-create-directory [path]))) + (exception.throw ..cannot_create_directory [path]))) #.Nil - (exception.throw ..cannot-create-directory [path])))) + (exception.throw ..cannot_create_directory [path])))) -(def: (retrieve-mock-directory! separator path mock) +(def: (retrieve_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-directory [path]) + (exception.throw ..cannot_find_directory [path]) (#.Some node) (case [node tail] - [(#.Right sub-directory) #.Nil] - (#try.Success sub-directory) + [(#.Right sub_directory) #.Nil] + (#try.Success sub_directory) - [(#.Right sub-directory) (#.Cons _)] - (recur sub-directory tail) + [(#.Right sub_directory) (#.Cons _)] + (recur sub_directory tail) _ - (exception.throw ..cannot-find-directory [path]))) + (exception.throw ..cannot_find_directory [path]))) #.Nil (#try.Success directory)))) -(def: (delete-mock-directory! separator path mock) +(def: (delete_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-discard-directory [path]) + (exception.throw ..cannot_discard_directory [path]) (#.Some node) (case [node tail] [(#.Right directory) #.Nil] (if (dictionary.empty? directory) (#try.Success (dictionary.remove head directory)) - (exception.throw ..cannot-discard-directory [path])) + (exception.throw ..cannot_discard_directory [path])) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-discard-directory [path]))) + (exception.throw ..cannot_discard_directory [path]))) #.Nil - (exception.throw ..cannot-discard-directory [path])))) + (exception.throw ..cannot_discard_directory [path])))) -(def: (mock-directory separator path store) +(def: (mock_directory separator path store) (-> Text Path (Var Mock) (Directory Promise)) (structure (def: scope - (..can-see + (..can_see (function (_ _) path))) (def: files - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [directory (..retrieve-mock-directory! separator path |store|)] + [directory (..retrieve_mock_directory! separator path |store|)] (wrap (|> directory dictionary.entries - (list.all (function (_ [node-name node]) + (list.all (function (_ [node_name node]) (case node (#.Left file) - (#.Some (..mock-file separator - node-name - (format path separator node-name) + (#.Some (..mock_file separator + node_name + (format path separator node_name) store)) (#.Right directory) #.None)))))))))))) (def: directories - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [directory (..retrieve-mock-directory! separator path |store|)] + [directory (..retrieve_mock_directory! separator path |store|)] (wrap (|> directory dictionary.entries - (list.all (function (_ [node-name node]) + (list.all (function (_ [node_name node]) (case node (#.Left file) #.None (#.Right directory) - (#.Some (mock-directory separator - (format path separator node-name) + (#.Some (mock_directory separator + (format path separator node_name) store)))))))))))))) (def: discard - (..can-delete + (..can_delete (function (_ _) (stm.commit (do {! stm.monad} [|store| (stm.read store)] - (case (..delete-mock-directory! separator path |store|) + (case (..delete_mock_directory! separator path |store|) (#try.Success |store|) (do ! [_ (stm.write |store| store)] @@ -1105,72 +1105,72 @@ (def: #export (mock separator) (-> Text (System Promise)) - (let [store (stm.var ..empty-mock)] + (let [store (stm.var ..empty_mock)] (structure (def: separator separator) (def: file - (..can-open + (..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 name path store))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (..mock_file separator name path store))))))))) - (def: create-file - (..can-open + (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|) + (case (..create_mock_file! separator path now |store|) (#try.Success [name |store|]) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success (..mock-file separator name path store)))) + (wrap (#try.Success (..mock_file separator name path store)))) (#try.Failure error) (wrap (#try.Failure error))))))))) (def: directory - (..can-open + (..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))))))))) + [directory (..retrieve_mock_directory! separator path |store|)] + (wrap (..mock_directory separator path store))))))))) - (def: create-directory - (..can-open + (def: create_directory + (..can_open (function (_ path) (stm.commit (do {! stm.monad} [|store| (stm.read store)] - (case (..create-mock-directory! separator path |store|) + (case (..create_mock_directory! separator path |store|) (#try.Success |store|) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success (..mock-directory separator path store)))) + (wrap (#try.Success (..mock_directory separator path store)))) (#try.Failure error) (wrap (#try.Failure error)))))))) ))) -(def: #export (make-directories monad system path) +(def: #export (make_directories monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try Path)))) - (let [rooted? (text.starts-with? (\ system separator) path) - segments (text.split-all-with (\ system separator) path)] + (let [rooted? (text.starts_with? (\ system separator) path) + segments (text.split_all_with (\ system separator) path)] (case (if rooted? (list.drop 1 segments) segments) #.Nil - (\ monad wrap (exception.throw ..cannot-create-directory [path])) + (\ monad wrap (exception.throw ..cannot_create_directory [path])) (#.Cons head tail) (loop [current (if rooted? @@ -1178,7 +1178,7 @@ head) next tail] (do (try.with monad) - [_ (..get-directory monad system current)] + [_ (..get_directory monad system current)] (case next #.Nil (wrap current) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 5d995bbd4..1a59721d4 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -90,164 +90,164 @@ (: (-> [] (! (Try (List [//.Path Concern])))) poll)) -(exception: #export (not-being-watched {path //.Path}) +(exception: #export (not_being_watched {path //.Path}) (exception.report ["Path" (%.text path)])) -(type: File-Tracker +(type: File_Tracker (Dictionary //.Path [(//.File Promise) Instant])) -(type: Directory-Tracker - (Dictionary //.Path [Concern (//.Directory Promise) File-Tracker])) +(type: Directory_Tracker + (Dictionary //.Path [Concern (//.Directory Promise) File_Tracker])) -(def: (update-watch! new-concern path tracker) - (-> Concern //.Path (Var Directory-Tracker) (STM Bit)) +(def: (update_watch! new_concern path tracker) + (-> Concern //.Path (Var Directory_Tracker) (STM Bit)) (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.get path @tracker) - (#.Some [old-concern file last-modified]) + (#.Some [old_concern file last_modified]) (do ! - [_ (stm.update (dictionary.put path [new-concern file last-modified]) tracker)] + [_ (stm.update (dictionary.put path [new_concern file last_modified]) tracker)] (wrap true)) #.None (wrap false)))) -(def: (file-tracker fs directory) - (-> (//.System Promise) (//.Directory Promise) (Promise (Try File-Tracker))) +(def: (file_tracker fs directory) + (-> (//.System Promise) (//.Directory Promise) (Promise (Try File_Tracker))) (do {! (try.with promise.monad)} [files (!.use (\ directory files) [])] (monad.fold ! (function (_ file tracker) (do ! - [last-modified (!.use (\ file last-modified) [])] + [last_modified (!.use (\ file last_modified) [])] (wrap (dictionary.put (!.use (\ file path) []) - [file last-modified] + [file last_modified] tracker)))) - (: File-Tracker + (: File_Tracker (dictionary.new text.hash)) files))) -(def: (poll-files directory file-tracker) - (-> (//.Directory Promise) File-Tracker (Promise (Try (List [//.Path (//.File Promise) Instant])))) +(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) [])] (monad.map ! (function (_ file) (do ! - [last-modified (!.use (\ file last-modified) [])] - (wrap [(!.use (\ file path) []) file last-modified]))) + [last_modified (!.use (\ file last_modified) [])] + (wrap [(!.use (\ file path) []) file last_modified]))) files))) -(def: (poll-directory-changes [path [concern directory file-tracker]]) - (-> [//.Path [Concern (//.Directory Promise) File-Tracker]] - (Promise (Try [[//.Path [Concern (//.Directory Promise) File-Tracker]] +(def: (poll_directory_changes [path [concern directory file_tracker]]) + (-> [//.Path [Concern (//.Directory Promise) File_Tracker]] + (Promise (Try [[//.Path [Concern (//.Directory Promise) File_Tracker]] [(List [//.Path (//.File Promise) Instant]) (List [//.Path Instant Instant]) (List [//.Path])]]))) (do {! (try.with promise.monad)} - [current-files (..poll-files directory file-tracker) + [current_files (..poll_files directory file_tracker) #let [creations (if (..creation? concern) - (list.filter (|>> product.left (dictionary.key? file-tracker) not) - current-files) + (list.filter (|>> product.left (dictionary.key? file_tracker) not) + current_files) (list)) - available (|> current-files + available (|> current_files (list\map product.left) - (set.from-list text.hash)) + (set.from_list text.hash)) deletions (if (..deletion? concern) - (|> (dictionary.entries file-tracker) + (|> (dictionary.entries file_tracker) (list\map product.left) (list.filter (|>> (set.member? available) not))) (list)) - modifications (list.all (function (_ [path file current-modification]) + modifications (list.all (function (_ [path file current_modification]) (do maybe.monad - [[_ previous-modification] (dictionary.get path file-tracker)] - (wrap [path previous-modification current-modification]))) - current-files)]] + [[_ previous_modification] (dictionary.get path file_tracker)] + (wrap [path previous_modification current_modification]))) + current_files)]] (wrap [[path [concern directory - (let [with-deletions (list\fold dictionary.remove file-tracker deletions) - with-creations (list\fold (function (_ [path file last-modified] tracker) - (dictionary.put path [file last-modified] tracker)) - with-deletions + (let [with_deletions (list\fold dictionary.remove file_tracker deletions) + with_creations (list\fold (function (_ [path file last_modified] tracker) + (dictionary.put path [file last_modified] tracker)) + with_deletions creations) - with-modifications (list\fold (function (_ [path previous-modification current-modification] tracker) + with_modifications (list\fold (function (_ [path previous_modification current_modification] tracker) (dictionary.update path (function (_ [file _]) - [file current-modification]) + [file current_modification]) tracker)) - with-creations + with_creations modifications)] - with-modifications)]] + with_modifications)]] [creations modifications deletions]]))) (def: #export (polling fs) (-> (//.System Promise) (Watcher Promise)) - (let [tracker (: (Var Directory-Tracker) + (let [tracker (: (Var Directory_Tracker) (stm.var (dictionary.new text.hash)))] (structure - (def: (start new-concern path) + (def: (start new_concern path) (do {! promise.monad} - [updated? (stm.commit (..update-watch! new-concern path tracker))] + [updated? (stm.commit (..update_watch! new_concern path tracker))] (if updated? (wrap (#try.Success [])) (do (try.with !) [directory (!.use (\ fs directory) path) - file-tracker (..file-tracker fs directory)] + file_tracker (..file_tracker fs directory)] (do ! - [_ (stm.commit (stm.update (dictionary.put path [new-concern directory file-tracker]) tracker))] + [_ (stm.commit (stm.update (dictionary.put path [new_concern directory file_tracker]) tracker))] (wrap (#try.Success []))))))) (def: (concern path) (stm.commit (do stm.monad [@tracker (stm.read tracker)] (wrap (case (dictionary.get path @tracker) - (#.Some [concern directory file-tracker]) + (#.Some [concern directory file_tracker]) (#try.Success concern) #.None - (exception.throw ..not-being-watched [path])))))) + (exception.throw ..not_being_watched [path])))))) (def: (stop path) (stm.commit (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.get path @tracker) - (#.Some [concern directory file-tracker]) + (#.Some [concern directory file_tracker]) (do ! [_ (stm.update (dictionary.remove path) tracker)] (wrap (#try.Success concern))) #.None - (wrap (exception.throw ..not-being-watched [path])))))) + (wrap (exception.throw ..not_being_watched [path])))))) (def: (poll _) (do promise.monad [@tracker (stm.commit (stm.read tracker))] (do {! (try.with promise.monad)} [changes (|> @tracker dictionary.entries - (monad.map ! ..poll-directory-changes)) + (monad.map ! ..poll_directory_changes)) _ (do promise.monad [_ (stm.commit (stm.write (|> changes (list\map product.left) - (dictionary.from-list text.hash)) + (dictionary.from_list text.hash)) tracker))] (wrap (#try.Success []))) #let [[creations modifications deletions] (list\fold (function (_ [_ [creations modifications deletions]] - [all-creations all-modifications all-deletions]) - [(list\compose creations all-creations) - (list\compose modifications all-modifications) - (list\compose deletions all-deletions)]) + [all_creations all_modifications all_deletions]) + [(list\compose creations all_creations) + (list\compose modifications all_modifications) + (list\compose deletions all_deletions)]) [(list) (list) (list)] changes)]] (wrap ($_ list\compose - (list\map (function (_ [path file last-modification]) [path ..creation]) creations) + (list\map (function (_ [path file last_modification]) [path ..creation]) creations) (|> modifications - (list.filter (function (_ [path previous-modification current-modification]) - (not (instant\= previous-modification current-modification)))) - (list\map (function (_ [path previous-modification current-modification]) + (list.filter (function (_ [path previous_modification current_modification]) + (not (instant\= previous_modification current_modification)))) + (list\map (function (_ [path previous_modification current_modification]) [path ..modification]))) (list\map (function (_ path) [path ..deletion]) deletions) ))))) @@ -259,7 +259,7 @@ [fs (..polling fs)])) -(with-expansions [<jvm> (as-is (import: java/lang/Object) +(with_expansions [<jvm> (as_is (import: java/lang/Object) (import: java/lang/String) @@ -298,7 +298,7 @@ (#static ENTRY_MODIFY (java/nio/file/WatchEvent$Kind java/nio/file/Path)) (#static ENTRY_DELETE (java/nio/file/WatchEvent$Kind java/nio/file/Path))]) - (def: (default\\event-concern event) + (def: (default\\event_concern event) (All [a] (-> (java/nio/file/WatchEvent a) Concern)) (let [kind (:coerce (java/nio/file/WatchEvent$Kind java/nio/file/Path) @@ -326,11 +326,11 @@ (watchable [] java/nio/file/Watchable) (pollEvents [] #io (java/util/List (java/nio/file/WatchEvent ?)))]) - (def: default\\key-concern + (def: default\\key_concern (-> java/nio/file/WatchKey (IO Concern)) (|>> java/nio/file/WatchKey::pollEvents (\ io.monad map (|>> ..default\\list - (list\map default\\event-concern) + (list\map default\\event_concern) (list\fold ..also ..none))))) (import: java/nio/file/WatchService @@ -350,14 +350,14 @@ (new [java/lang/String]) (toPath [] java/nio/file/Path)]) - (type: Watch-Event + (type: Watch_Event (java/nio/file/WatchEvent$Kind java/lang/Object)) - (def: (default\\start watch-events watcher path) - (-> (List Watch-Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) + (def: (default\\start watch_events watcher path) + (-> (List Watch_Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) (promise.future (java/nio/file/Path::register watcher - (array.from-list watch-events) + (array.from_list watch_events) (|> path java/io/File::new java/io/File::toPath)))) (def: (default\\poll watcher) @@ -377,7 +377,7 @@ (:coerce java/nio/file/Path) java/nio/file/Path::toString (:coerce //.Path))] - concern (..default\\key-concern key)] + concern (..default\\key_concern key)] (recur (#.Cons [path concern] output))) (recur output))) @@ -385,17 +385,17 @@ #.None (wrap output))))) - (def: (watch-events concern) - (-> Concern (List Watch-Event)) + (def: (watch_events concern) + (-> Concern (List Watch_Event)) ($_ list\compose (if (..creation? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) (list)) (if (..modification? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) (list)) (if (..deletion? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) (list)) )) @@ -420,14 +420,14 @@ (wrap (#try.Success concern))) #.None - (wrap (exception.throw ..not-being-watched [path]))))))]] + (wrap (exception.throw ..not_being_watched [path]))))))]] (wrap (: (Watcher Promise) (structure (def: (start concern path) (do promise.monad [?concern (stop path)] (do (try.with promise.monad) - [key (..default\\start (..watch-events (..also (try.default ..none ?concern) + [key (..default\\start (..watch_events (..also (try.default ..none ?concern) concern)) watcher path)] @@ -442,11 +442,11 @@ (wrap (#try.Success concern)) #.None - (wrap (exception.throw ..not-being-watched [path]))))) + (wrap (exception.throw ..not_being_watched [path]))))) (def: stop stop) (def: (poll _) (promise.future (..default\\poll watcher))) ))))) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index eb8a05f9c..049a80dea 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -60,7 +60,7 @@ ## Do not trust the values of environment variables ## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables -(with-expansions [<jvm> (as-is (import: java/lang/String) +(with_expansions [<jvm> (as_is (import: java/lang/String) (import: (java/util/Map$Entry k v) ["#::." @@ -93,44 +93,44 @@ (jvm\\consume f iterator)) #.Nil)) - (def: (jvm\\to-kv entry) + (def: (jvm\\to_kv entry) (All [k v] (-> (java/util/Map$Entry k v) [k v])) [(java/util/Map$Entry::getKey entry) (java/util/Map$Entry::getValue entry)]) (def: jvm\\environment (IO Environment) - (with-expansions [<jvm> (as-is (io.io (|> (java/lang/System::getenv) + (with_expansions [<jvm> (as_is (io.io (|> (java/lang/System::getenv) java/util/Map::entrySet java/util/Set::iterator - (..jvm\\consume ..jvm\\to-kv) - (dictionary.from-list text.hash))))] + (..jvm\\consume ..jvm\\to_kv) + (dictionary.from_list text.hash))))] (for {@.old <jvm> @.jvm <jvm>}))) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) (structure: #export default (Program IO) (def: (environment _) - (with-expansions [<jvm> ..jvm\\environment] + (with_expansions [<jvm> ..jvm\\environment] (for {@.old <jvm> @.jvm <jvm>}))) (def: (home _) - (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] + (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] (for {@.old <jvm> @.jvm <jvm>}))) (def: (directory _) - (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] + (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] (for {@.old <jvm> @.jvm <jvm>}))) (def: (exit code) - (with-expansions [<jvm> (do io.monad + (with_expansions [<jvm> (do io.monad [_ (java/lang/System::exit code)] (wrap (undefined)))] (for {@.old <jvm> diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index aaa686061..273d64039 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -30,14 +30,14 @@ [// [file (#+ Path)]]) -(capability: #export (Can-Read !) - (can-read [] (! (Try Text)))) +(capability: #export (Can_Read !) + (can_read [] (! (Try Text)))) -(capability: #export (Can-Write !) - (can-write Text (! (Try Any)))) +(capability: #export (Can_Write !) + (can_write Text (! (Try Any)))) -(capability: #export (Can-Destroy !) - (can-destroy [] (! (Try Any)))) +(capability: #export (Can_Destroy !) + (can_destroy [] (! (Try Any)))) (type: #export Exit Int) @@ -51,22 +51,22 @@ [+1 error] ) -(capability: #export (Can-Wait !) - (can-wait [] (! (Try Exit)))) +(capability: #export (Can_Wait !) + (can_wait [] (! (Try Exit)))) (signature: #export (Process !) - (: (Can-Read !) + (: (Can_Read !) read) - (: (Can-Read !) + (: (Can_Read !) error) - (: (Can-Write !) + (: (Can_Write !) write) - (: (Can-Destroy !) + (: (Can_Destroy !) destroy) - (: (Can-Wait !) + (: (Can_Wait !) await)) -(def: (async-process process) +(def: (async_process process) (-> (Process IO) (Process Promise)) (`` (structure (~~ (template [<method> <capability>] @@ -75,11 +75,11 @@ (|>> (!.use (\ process <method>)) promise.future)))] - [read ..can-read] - [error ..can-read] - [write ..can-write] - [destroy ..can-destroy] - [await ..can-wait] + [read ..can_read] + [error ..can_read] + [write ..can_write] + [destroy ..can_destroy] + [await ..can_wait] ))))) (type: #export Command @@ -88,23 +88,23 @@ (type: #export Argument Text) -(capability: #export (Can-Execute !) - (can-execute [Environment Path Command (List Argument)] (! (Try (Process !))))) +(capability: #export (Can_Execute !) + (can_execute [Environment Path Command (List Argument)] (! (Try (Process !))))) (signature: #export (Shell !) - (: (Can-Execute !) + (: (Can_Execute !) execute)) (def: #export (async shell) (-> (Shell IO) (Shell Promise)) (structure (def: execute - (..can-execute + (..can_execute (function (_ input) (promise.future (do (try.with io.monad) [process (!.use (\ shell execute) input)] - (wrap (..async-process process))))))))) + (wrap (..async_process process))))))))) (signature: (Policy ?) (: (-> Command (Safe Command ?)) @@ -122,12 +122,12 @@ (def: (replace bad replacer) (-> Text Replacer (-> Text Text)) - (text.replace-all bad (replacer bad))) + (text.replace_all bad (replacer bad))) -(def: sanitize-common-command +(def: sanitize_common_command (-> Replacer (Sanitizer Command)) - (let [x0A (text.from-code (hex "0A")) - xFF (text.from-code (hex "FF"))] + (let [x0A (text.from_code (hex "0A")) + xFF (text.from_code (hex "FF"))] (function (_ replacer) (|>> (..replace x0A replacer) (..replace xFF replacer) @@ -147,49 +147,49 @@ (..replace "[" replacer) (..replace "]" replacer) (..replace "{" replacer) (..replace "}" replacer))))) -(def: (policy sanitize-command sanitize-argument) +(def: (policy sanitize_command sanitize_argument) (Ex [?] (-> (Sanitizer Command) (Sanitizer Argument) (Policy ?))) - (?.with-policy + (?.with_policy (: (Context Safety Policy) (function (_ (^open "?\.")) (structure - (def: command (|>> sanitize-command (!.use ?\can-upgrade))) - (def: argument (|>> sanitize-argument (!.use ?\can-upgrade))) - (def: value (!.use ?\can-downgrade))))))) + (def: command (|>> sanitize_command (!.use ?\can_upgrade))) + (def: argument (|>> sanitize_argument (!.use ?\can_upgrade))) + (def: value (!.use ?\can_downgrade))))))) -(def: unix-policy +(def: unix_policy (let [replacer (: Replacer (|>> (format "\"))) - sanitize-command (: (Sanitizer Command) - (..sanitize-common-command replacer)) - sanitize-argument (: (Sanitizer Argument) + sanitize_command (: (Sanitizer Command) + (..sanitize_common_command replacer)) + sanitize_argument (: (Sanitizer Argument) (|>> (..replace "'" replacer) (text.enclose' "'")))] - (..policy sanitize-command sanitize-argument))) + (..policy sanitize_command sanitize_argument))) -(def: windows-policy +(def: windows_policy (let [replacer (: Replacer (function.constant " ")) - sanitize-command (: (Sanitizer Command) - (|>> (..sanitize-common-command replacer) + sanitize_command (: (Sanitizer Command) + (|>> (..sanitize_common_command replacer) (..replace "%" replacer) (..replace "!" replacer))) - sanitize-argument (: (Sanitizer Argument) + sanitize_argument (: (Sanitizer Argument) (|>> (..replace "%" replacer) (..replace "!" replacer) - (..replace text.double-quote replacer) - (text.enclose' text.double-quote)))] - (..policy sanitize-command sanitize-argument))) + (..replace text.double_quote replacer) + (text.enclose' text.double_quote)))] + (..policy sanitize_command sanitize_argument))) -(with-expansions [<jvm> (as-is (import: java/lang/String +(with_expansions [<jvm> (as_is (import: java/lang/String ["#::." (toLowerCase [] java/lang/String)]) - (def: (jvm::arguments-array arguments) + (def: (jvm::arguments_array arguments) (-> (List Argument) (Array java/lang/String)) (product.right (list\fold (function (_ argument [idx output]) - [(inc idx) (jvm.array-write idx argument output)]) + [(inc idx) (jvm.array_write idx argument output)]) [0 (jvm.array java/lang/String (list.size arguments))] arguments))) @@ -197,7 +197,7 @@ ["#::." (put [k v] v)]) - (def: (jvm::load-environment input target) + (def: (jvm::load_environment input target) (-> Environment (java/util/Map java/lang/String java/lang/String) (java/util/Map java/lang/String java/lang/String)) @@ -234,33 +234,33 @@ (destroy [] #io #try void) (waitFor [] #io #try int)]) - (def: (default-process process) + (def: (default_process process) (-> java/lang/Process (IO (Try (Process IO)))) (do (try.with io.monad) - [jvm-input (java/lang/Process::getInputStream process) - jvm-error (java/lang/Process::getErrorStream process) - jvm-output (java/lang/Process::getOutputStream process) - #let [jvm-input (|> jvm-input + [jvm_input (java/lang/Process::getInputStream process) + jvm_error (java/lang/Process::getErrorStream process) + jvm_output (java/lang/Process::getOutputStream process) + #let [jvm_input (|> jvm_input java/io/InputStreamReader::new java/io/BufferedReader::new) - jvm-error (|> jvm-error + jvm_error (|> jvm_error java/io/InputStreamReader::new java/io/BufferedReader::new)]] (wrap (: (Process IO) (`` (structure (~~ (template [<name> <stream>] [(def: <name> - (..can-read + (..can_read (function (_ _) (java/io/BufferedReader::readLine <stream>))))] - [read jvm-input] - [error jvm-error] + [read jvm_input] + [error jvm_error] )) (def: write - (..can-write + (..can_write (function (_ message) - (|> jvm-output + (|> jvm_output (java/io/OutputStream::write (\ encoding.utf8 encode message)))))) (~~ (template [<name> <capability> <method>] [(def: <name> @@ -268,8 +268,8 @@ (function (_ _) (<method> process))))] - [destroy ..can-destroy java/lang/Process::destroy] - [await ..can-wait java/lang/Process::waitFor] + [destroy ..can_destroy java/lang/Process::destroy] + [await ..can_wait java/lang/Process::waitFor] )))))))) (import: java/io/File @@ -287,63 +287,63 @@ ["#::." (#static getProperty [java/lang/String] #io #try java/lang/String)]) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) ## https://en.wikipedia.org/wiki/Code_injection#Shell_injection (def: windows? (IO (Try Bit)) (\ (try.with io.monad) map - (|>> java/lang/String::toLowerCase (text.starts-with? "windows")) + (|>> java/lang/String::toLowerCase (text.starts_with? "windows")) (java/lang/System::getProperty "os.name"))) -(def: (jvm::process-builder policy command arguments) +(def: (jvm::process_builder policy command arguments) (All [?] (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) java/lang/ProcessBuilder)) (|> (list\map (\ policy value) arguments) (list& (\ policy value command)) - ..jvm::arguments-array + ..jvm::arguments_array java/lang/ProcessBuilder::new)) (structure: #export default (Shell IO) (def: execute - (..can-execute - (function (_ [environment working-directory command arguments]) - (with-expansions [<jvm> (as-is (do {! (try.with io.monad)} + (..can_execute + (function (_ [environment working_directory command arguments]) + (with_expansions [<jvm> (as_is (do {! (try.with io.monad)} [windows? ..windows? #let [builder (if windows? - (..jvm::process-builder ..windows-policy - (\ ..windows-policy command command) - (list\map (\ ..windows-policy argument) arguments)) - (..jvm::process-builder ..unix-policy - (\ ..unix-policy command command) - (list\map (\ ..unix-policy argument) arguments)))] + (..jvm::process_builder ..windows_policy + (\ ..windows_policy command command) + (list\map (\ ..windows_policy argument) arguments)) + (..jvm::process_builder ..unix_policy + (\ ..unix_policy command command) + (list\map (\ ..unix_policy argument) arguments)))] _ (|> builder - (java/lang/ProcessBuilder::directory (java/io/File::new working-directory)) + (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)) java/lang/ProcessBuilder::environment - (\ try.functor map (..jvm::load-environment 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>)})))))) + (..default_process process)))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})))))) (signature: #export (Simulation s) (: (-> s (Try [s Text])) - on-read) + on_read) (: (-> s (Try [s Text])) - on-error) + on_error) (: (-> Text s (Try s)) - on-write) + on_write) (: (-> s (Try s)) - on-destroy) + on_destroy) (: (-> s (Try [s Exit])) - on-await)) + on_await)) -(`` (structure: (mock-process simulation state) +(`` (structure: (mock_process simulation state) (All [s] (-> (Simulation s) (Var s) (Process Promise))) (~~ (template [<name> <capability> <simulation>] @@ -362,17 +362,17 @@ (#try.Failure error) (wrap (#try.Failure error))))))))] - [read ..can-read on-read] - [error ..can-read on-error] - [await ..can-wait on-await] + [read ..can_read on_read] + [error ..can_read on_error] + [await ..can_wait on_await] )) (def: write - (..can-write + (..can_write (function (_ message) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-write message |state|) + (case (\ simulation on_write message |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -381,12 +381,12 @@ (#try.Failure error) (wrap (#try.Failure error)))))))) (def: destroy - (..can-destroy + (..can_destroy (function (_ _) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-destroy |state|) + (case (\ simulation on_destroy |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -403,9 +403,9 @@ (Shell Promise))) (def: execute - (..can-execute + (..can_execute (function (_ input) (promise\wrap (do try.monad [simulation (simulation input)] - (wrap (..mock-process simulation (stm.var init))))))))) + (wrap (..mock_process simulation (stm.var init))))))))) |