diff options
| author | Eduardo Julian | 2021-07-06 21:34:21 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-07-06 21:34:21 -0400 |
| commit | 2b909032e7a0bd10cd7db52067d2fb701bfa95e5 (patch) | |
| tree | 0e2aaef228f80f3336715327f7f34065c309de22 /stdlib | |
| parent | 5cf4efa861075f8276f43a2516f5beacaf610b44 (diff) | |
Simplified the API for file-system operations.
Diffstat (limited to 'stdlib')
44 files changed, 1952 insertions, 2389 deletions
diff --git a/stdlib/source/lux/abstract/predicate.lux b/stdlib/source/lux/abstract/predicate.lux index 03b071fa4..841865c10 100644 --- a/stdlib/source/lux/abstract/predicate.lux +++ b/stdlib/source/lux/abstract/predicate.lux @@ -10,12 +10,12 @@ (type: #export (Predicate a) (-> a Bit)) -(template [<identity-name> <identity-value> <composition-name> <composition>] - [(def: #export <identity-name> +(template [<identity_name> <identity_value> <composition_name> <composition>] + [(def: #export <identity_name> Predicate - (function.constant <identity-value>)) + (function.constant <identity_value>)) - (def: #export (<composition-name> left right) + (def: #export (<composition_name> left right) (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) (<composition> (left value) diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 8dcfbfd48..0ab73684c 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -5,9 +5,12 @@ [abstract ["." monad (#+ do)]] [control + ["." try] ["." exception (#+ exception:)] ["." io (#+ IO io)]] [data + ["." text + ["%" format (#+ format)]] [collection ["." list]]] [math @@ -84,50 +87,51 @@ (Atom (List Thread)) (atom.atom (list))))) +(def: (execute! action) + (-> (IO Any) Any) + (case ("lux try" action) + (#try.Failure error) + (exec + ("lux io log" (format "ERROR DURING THREAD EXECUTION:" text.new_line + error)) + []) + + (#try.Success _) + [])) + (def: #export (schedule milli_seconds action) (-> Nat (IO Any) (IO Any)) - (for {@.old - (let [runnable (ffi.object [] [java/lang/Runnable] - [] - (java/lang/Runnable [] (run self) void - (io.run action)))] - (case milli_seconds - 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS - runner))) - - @.jvm - (let [runnable (ffi.object [] [java/lang/Runnable] - [] - (java/lang/Runnable [] (run self) void - (io.run action)))] - (case milli_seconds - 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS - runner))) - - @.js - (..setTimeout [(ffi.closure [] (io.run action)) - (n.frac milli_seconds)]) - - @.python - (do io.monad - [_ (|> (ffi.lambda [] (io.run action)) - [(|> milli_seconds n.frac (f./ +1,000.0))] - threading/Timer::new - (threading/Timer::start []))] - (wrap []))} - - ## Default - (do io.monad - [_ (atom.update (|>> (#.Cons {#creation (|> instant.now - io.run - instant.to_millis - .nat) - #delay milli_seconds - #action action})) - ..runner)] - (wrap [])))) + (with_expansions [<jvm> (as_is (let [runnable (ffi.object [] [java/lang/Runnable] + [] + (java/lang/Runnable [] (run self) void + (..execute! action)))] + (case milli_seconds + 0 (java/util/concurrent/Executor::execute runnable runner) + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS + runner))))] + (for {@.old <jvm> + @.jvm <jvm> + + @.js + (..setTimeout [(ffi.closure [] (..execute! action)) + (n.frac milli_seconds)]) + + @.python + (do io.monad + [_ (|> (ffi.lambda [] (..execute! action)) + [(|> milli_seconds n.frac (f./ +1,000.0))] + threading/Timer::new + (threading/Timer::start []))] + (wrap []))} + + ## Default + (do {! io.monad} + [now (\ ! map (|>> instant.to_millis .nat) instant.now) + _ (atom.update (|>> (#.Cons {#creation now + #delay milli_seconds + #action action})) + ..runner)] + (wrap []))))) (for {@.old (as_is) @.jvm (as_is) @@ -149,11 +153,8 @@ _ (do ! - [#let [now (|> instant.now - io.run - instant.to_millis - .nat) - [ready pending] (list.partition (function (_ thread) + [now (\ ! map (|>> instant.to_millis .nat) instant.now) + #let [[ready pending] (list.partition (function (_ thread) (|> (get@ #creation thread) (n.+ (get@ #delay thread)) (n.<= now))) @@ -161,7 +162,7 @@ swapped? (atom.compare_and_swap threads pending ..runner)] (if swapped? (do ! - [_ (monad.map ! (get@ #action) ready)] + [_ (monad.map ! (|>> (get@ #action) ..execute! io.io) ready)] (recur [])) (error! (exception.construct ..cannot_continue_running_threads [])))) )))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 766d7b928..6bc7d5ebd 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -121,6 +121,28 @@ _ false)) +(def: #export (prefix param subject) + (-> Text Text Text) + ("lux text concat" param subject)) + +(def: #export (suffix param subject) + (-> Text Text Text) + ("lux text concat" subject param)) + +(def: #export (enclose [left right] content) + {#.doc "Surrounds the given content text with left and right side additions."} + (-> [Text Text] Text Text) + ($_ "lux text concat" left content right)) + +(def: #export (enclose' boundary content) + {#.doc "Surrounds the given content text with the same boundary text."} + (-> Text Text Text) + (enclose [boundary boundary] content)) + +(def: #export format + (-> Text Text) + (..enclose' ..double_quote)) + (def: #export (clip offset characters input) (-> Nat Nat Text (Maybe Text)) (if (|> characters (n.+ offset) (n.<= ("lux text size" input))) @@ -153,12 +175,18 @@ (def: #export (split_all_with token sample) (-> Text Text (List Text)) - (case (..split_with token sample) - (#.Some [pre post]) - (#.Cons pre (split_all_with token post)) - - #.None - (#.Cons sample #.Nil))) + (loop [input sample + output (: (List Text) (list))] + (case (..split_with token input) + (#.Some [pre post]) + (|> output + (#.Cons pre) + (recur post)) + + #.None + (|> output + (#.Cons input) + list.reverse)))) (def: #export (replace_once pattern replacement template) (-> Text Text Text Text) @@ -280,28 +308,6 @@ "" true _ false)) -(def: #export (prefix param subject) - (-> Text Text Text) - ("lux text concat" param subject)) - -(def: #export (suffix param subject) - (-> Text Text Text) - ("lux text concat" subject param)) - -(def: #export (enclose [left right] content) - {#.doc "Surrounds the given content text with left and right side additions."} - (-> [Text Text] Text Text) - ($_ "lux text concat" left content right)) - -(def: #export (enclose' boundary content) - {#.doc "Surrounds the given content text with the same boundary text."} - (-> Text Text Text) - (enclose [boundary boundary] content)) - -(def: #export format - (-> Text Text) - (..enclose' ..double_quote)) - (def: #export space Text " ") diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index c7cace208..117df224c 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -233,6 +233,7 @@ [ascii [//block.basic_latin (list)]] [ascii/alpha [//block.basic_latin/upper (list //block.basic_latin/lower)]] [ascii/alpha_num [//block.basic_latin/upper (list //block.basic_latin/lower //block.basic_latin/decimal)]] + [ascii/numeric [//block.basic_latin/decimal (list)]] [ascii/upper [//block.basic_latin/upper (list)]] [ascii/lower [//block.basic_latin/lower (list)]] ) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 9ed201d95..8c95c63fa 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -177,6 +177,7 @@ [ascii unicode.ascii] [ascii/alpha unicode.ascii/alpha] [ascii/alpha_num unicode.ascii/alpha_num] + [ascii/numeric unicode.ascii/numeric] [ascii/upper unicode.ascii/upper] [ascii/lower unicode.ascii/lower] ) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 48dc7c792..cf951e9a1 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -165,9 +165,8 @@ (exception: #export must_try_test_at_least_once) -## TODO: Figure out why tests sometimes freeze and fix it. Delete "times'" afterwards. -(def: #export (times' millis_time_out amount test) - (-> (Maybe Nat) Nat Test Test) +(def: #export (times amount test) + (-> Nat Test Test) (case amount 0 (..fail (exception.construct ..must_try_test_at_least_once [])) _ (do random.monad @@ -175,38 +174,15 @@ (function (recur prng) (let [[prng' instance] (random.run (random.pcg32 [..pcg32_magic_inc seed]) test)] [prng' (do {! promise.monad} - [outcome (case millis_time_out - (#.Some millis_time_out) - (promise.time_out millis_time_out instance) - - #.None - (\ ! map (|>> #.Some) instance))] - (case outcome - (#.Some [tally documentation]) - (if (failed? tally) - (wrap [tally (times_failure seed documentation)]) - (case amount - 1 instance - _ (|> test - (times' millis_time_out (dec amount)) - (random.run prng') - product.right))) - - #.None - (exec - (debug.log! "Time-out reached! Retrying tests...") - (product.right (recur prng)))))]))))) - -## TODO: Figure out why tests sometimes freeze and fix it. Delete "seed'" afterwards. -(def: #export (seed' millis_time_out value test) - (-> (Maybe Nat) Seed Test Test) - (<| (..times' millis_time_out 1) - (..seed value) - test)) - -(def: #export times - (-> Nat Test Test) - (..times' #.None)) + [[tally documentation] instance] + (if (..failed? tally) + (wrap [tally (times_failure seed documentation)]) + (case amount + 1 instance + _ (|> test + (times (dec amount)) + (random.run prng') + product.right))))]))))) (def: (description duration tally) (-> Duration Tally Text) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 2006fcd79..b6bf39c18 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -1,10 +1,11 @@ (.module: [lux (#- Module) - ["@" target (#+ Target)] + [target (#+ Target)] [abstract [predicate (#+ Predicate)] ["." monad (#+ do)]] [control + [pipe (#+ case>)] ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency @@ -25,7 +26,7 @@ [number ["n" nat]]] [world - ["." file (#+ Path File Directory)]]] + ["." file]]] [program [compositor [import (#+ Import)] @@ -49,7 +50,7 @@ ["." directive] ["#/." program]]]]]]) -(exception: #export (cannot_prepare {archive Path} +(exception: #export (cannot_prepare {archive file.Path} {module_id archive.ID} {error Text}) (exception.report @@ -57,111 +58,101 @@ ["Module ID" (%.nat module_id)] ["Error" error])) -(def: (archive system static) - (All [!] (-> (file.System !) Static Path)) +(def: (archive fs static) + (All [!] (-> (file.System !) Static file.Path)) (format (get@ #static.target static) - (\ system separator) + (\ fs separator) (get@ #static.host static))) -(def: (unversioned_lux_archive system static) - (All [!] (-> (file.System !) Static Path)) - (format (..archive system static) - (\ system separator) +(def: (unversioned_lux_archive fs static) + (All [!] (-> (file.System !) Static file.Path)) + (format (..archive fs static) + (\ fs separator) //.lux_context)) -(def: (versioned_lux_archive system static) - (All [!] (-> (file.System !) Static Path)) - (format (..unversioned_lux_archive system static) - (\ system separator) +(def: (versioned_lux_archive fs static) + (All [!] (-> (file.System !) Static file.Path)) + (format (..unversioned_lux_archive fs static) + (\ fs separator) (%.nat version.version))) -(def: (module system static module_id) - (All [!] (-> (file.System !) Static archive.ID Path)) - (format (..versioned_lux_archive system static) - (\ system separator) +(def: (module fs static module_id) + (All [!] (-> (file.System !) Static archive.ID file.Path)) + (format (..versioned_lux_archive fs static) + (\ fs separator) (%.nat module_id))) -(def: #export (artifact system static module_id artifact_id) - (All [!] (-> (file.System !) Static archive.ID artifact.ID Path)) - (format (..module system static module_id) - (\ system separator) +(def: #export (artifact fs static module_id artifact_id) + (All [!] (-> (file.System !) Static archive.ID artifact.ID file.Path)) + (format (..module fs static module_id) + (\ fs separator) (%.nat artifact_id) (get@ #static.artifact_extension static))) -(def: #export (prepare system static module_id) +(def: (ensure_directory fs path) + (-> (file.System Promise) file.Path (Promise (Try Any))) + (do promise.monad + [? (\ fs directory? path)] + (if ? + (wrap (#try.Success [])) + (\ fs make_directory path)))) + +(def: #export (prepare fs static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try Any))) (do {! promise.monad} - [#let [module (..module system static module_id)] - module_exists? (file.exists? promise.monad system module)] + [#let [module (..module fs static module_id)] + module_exists? (\ fs directory? module)] (if module_exists? (wrap (#try.Success [])) - (do ! - [_ (file.get_directory ! system (..unversioned_lux_archive system static)) - _ (file.get_directory ! system (..versioned_lux_archive system static)) - outcome (\ system create_directory module)] - (case outcome - (#try.Success output) - (wrap (#try.Success [])) - - (#try.Failure error) - (wrap (exception.throw ..cannot_prepare [(..archive system static) - module_id - error]))))))) - -(def: #export (write system static module_id artifact_id content) + (do (try.with !) + [_ (ensure_directory fs (..unversioned_lux_archive fs static)) + _ (ensure_directory fs (..versioned_lux_archive fs static))] + (|> module + (\ fs make_directory) + (\ ! map (|>> (case> (#try.Success output) + (#try.Success []) + + (#try.Failure error) + (exception.throw ..cannot_prepare [(..archive fs static) + module_id + error]))))))))) + +(def: #export (write fs static module_id artifact_id content) (-> (file.System Promise) Static archive.ID artifact.ID Binary (Promise (Try Any))) - (do (try.with promise.monad) - [artifact (: (Promise (Try (File Promise))) - (file.get_file promise.monad system - (..artifact system static module_id artifact_id)))] - (\ artifact over_write content))) + (\ fs write content (..artifact fs static module_id artifact_id))) -(def: #export (enable system static) +(def: #export (enable fs static) (-> (file.System Promise) Static (Promise (Try Any))) (do (try.with promise.monad) - [_ (: (Promise (Try (Directory Promise))) - (file.get_directory promise.monad system (get@ #static.target static))) - _ (: (Promise (Try (Directory Promise))) - (file.get_directory promise.monad system (..archive system static)))] - (wrap []))) - -(def: (general_descriptor system static) - (-> (file.System Promise) Static Path) - (format (..archive system static) - (\ system separator) + [_ (..ensure_directory fs (get@ #static.target static))] + (..ensure_directory fs (..archive fs static)))) + +(def: (general_descriptor fs static) + (-> (file.System Promise) Static file.Path) + (format (..archive fs static) + (\ fs separator) "general_descriptor")) -(def: #export (freeze system static archive) +(def: #export (freeze fs static archive) (-> (file.System Promise) Static Archive (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system (..general_descriptor system static)))] - (\ file over_write (archive.export ///.version archive)))) + (\ fs write (archive.export ///.version archive) (..general_descriptor fs static))) (def: module_descriptor_file "module_descriptor") -(def: (module_descriptor system static module_id) - (-> (file.System Promise) Static archive.ID Path) - (format (..module system static module_id) - (\ system separator) +(def: (module_descriptor fs static module_id) + (-> (file.System Promise) Static archive.ID file.Path) + (format (..module fs static module_id) + (\ fs separator) ..module_descriptor_file)) -(def: #export (cache system static module_id content) +(def: #export (cache fs static module_id content) (-> (file.System Promise) Static archive.ID Binary (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system - (..module_descriptor system static module_id)))] - (\ file over_write content))) + (\ fs write content (..module_descriptor fs static module_id))) -(def: (read_module_descriptor system static module_id) +(def: (read_module_descriptor fs static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try Binary))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system - (..module_descriptor system static module_id)))] - (\ file content []))) + (\ fs read (..module_descriptor fs static module_id))) (def: parser (Parser [Descriptor (Document .Module)]) @@ -184,24 +175,20 @@ (archive.archived archive)))] (wrap (set@ #.modules modules (fresh_analysis_state host))))) -(def: (cached_artifacts system static module_id) +(def: (cached_artifacts fs static module_id) (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary)))) - (do {! (try.with promise.monad)} - [module_dir (\ system directory (..module system static module_id)) - cached_files (\ module_dir files [])] - (|> cached_files - (list\map (function (_ file) - [(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))) - (\ system file path)) - data (: (Promise (Try Binary)) - (\ file content []))] - (wrap [name data])))) - (\ ! map (dictionary.from_list text.hash))))) + (let [! (try.with promise.monad)] + (|> (..module fs static module_id) + (\ fs directory_files) + (\ ! map (|>> (list\map (function (_ file) + [(file.name fs file) file])) + (list.filter (|>> product.left (text\= ..module_descriptor_file) not)) + (monad.map ! (function (_ [name path]) + (|> path + (\ fs read) + (\ ! map (|>> [name]))))) + (\ ! map (dictionary.from_list text.hash)))) + (\ ! join)))) (type: Definitions (Dictionary Text Any)) (type: Analysers (Dictionary Text analysis.Handler)) @@ -321,27 +308,27 @@ (wrap [(document.write $.key (set@ #.definitions definitions content)) bundles]))) -(def: (load_definitions system static module_id host_environment [descriptor document output]) +(def: (load_definitions fs static module_id host_environment [descriptor document output]) (All [expression directive] (-> (file.System Promise) Static archive.ID (generation.Host expression directive) [Descriptor (Document .Module) Output] (Promise (Try [[Descriptor (Document .Module) Output] Bundles])))) (do (try.with promise.monad) - [actual (cached_artifacts system static module_id) + [actual (cached_artifacts fs static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] [document bundles] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] (wrap [[descriptor document output] bundles]))) -(def: (purge! system static [module_name module_id]) +(def: (purge! fs static [module_name module_id]) (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any))) (do {! (try.with promise.monad)} - [cache (\ system directory (..module system static module_id)) - artifacts (\ cache files []) - _ (monad.map ! (function (_ artifact) - (\ artifact delete [])) - artifacts)] - (\ cache discard []))) + [#let [cache (..module fs static module_id)] + _ (|> cache + (\ fs directory_files) + (\ ! map (monad.map ! (\ fs delete))) + (\ ! join))] + (\ fs delete cache))) (def: (valid_cache? expected actual) (-> Descriptor Input Bit) @@ -386,7 +373,7 @@ Text "(Lux Caching System)") -(def: (load_every_reserved_module host_environment system static import contexts archive) +(def: (load_every_reserved_module host_environment fs static import contexts archive) (All [expression directive] (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive (Promise (Try [Archive .Lux Bundles])))) @@ -395,13 +382,13 @@ archive.reservations (monad.map ! (function (_ [module_name module_id]) (do ! - [data (..read_module_descriptor system static module_id) + [data (..read_module_descriptor fs static module_id) [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)]]]]) (do ! - [input (//context.read system ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)] + [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)] (wrap [(..valid_cache? descriptor input) [module_name [module_id [descriptor document (: Output row.empty)]]]]))))))) load_order (|> pre_loaded_caches @@ -416,13 +403,13 @@ #let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries - (monad.map ! (..purge! system static))) + (monad.map ! (..purge! fs static))) loaded_caches (|> load_order (list.filter (function (_ [module_name [module_id [descriptor document output]]]) (not (dictionary.key? purge module_name)))) (monad.map ! (function (_ [module_name [module_id descriptor,document,output]]) (do ! - [[descriptor,document,output bundles] (..load_definitions system static module_id host_environment descriptor,document,output)] + [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor,document,output)] (wrap [[module_name descriptor,document,output] bundles])))))] (promise\wrap @@ -444,18 +431,17 @@ ..empty_bundles loaded_caches)]))))) -(def: #export (thaw host_environment system static import contexts) +(def: #export (thaw host_environment fs static import contexts) (All [expression directive] (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) (Promise (Try [Archive .Lux Bundles])))) (do promise.monad - [file (\ system file (..general_descriptor system static))] - (case file - (#try.Success file) + [binary (\ fs read (..general_descriptor fs static))] + (case binary + (#try.Success binary) (do (try.with promise.monad) - [binary (\ file content []) - archive (promise\wrap (archive.import ///.version binary))] - (..load_every_reserved_module host_environment system static import contexts archive)) + [archive (promise\wrap (archive.import ///.version binary))] + (..load_every_reserved_module host_environment fs static import contexts archive)) (#try.Failure error) (wrap (#try.Success [archive.empty diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 788be9fed..f31b4e1b2 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -18,7 +18,7 @@ [collection ["." dictionary (#+ Dictionary)]]] [world - ["." file (#+ Path File)]]] + ["." file]]] [program [compositor [import (#+ Import)]]] @@ -44,55 +44,53 @@ Extension ".lux") -(def: #export (path system context module) - (All [m] (-> (file.System m) Context Module Path)) +(def: #export (path fs context module) + (All [m] (-> (file.System m) Context Module file.Path)) (|> module - (//.sanitize system) - (format context (\ system separator)))) + (//.sanitize fs) + (format context (\ fs separator)))) -(def: (find_source_file system importer contexts module extension) +(def: (find_source_file fs importer contexts module extension) (-> (file.System Promise) Module (List Context) Module Extension - (Promise (Try [Path (File Promise)]))) + (Promise (Try file.Path))) (case contexts #.Nil (promise\wrap (exception.throw ..cannot_find_module [importer module])) (#.Cons context contexts') - (do promise.monad - [#let [path (format (..path system context module) extension)] - file (\ system file [path])] - (case file - (#try.Success file) - (wrap (#try.Success [path file])) - - (#try.Failure _) - (find_source_file system importer contexts' module extension))))) + (let [path (format (..path fs context module) extension)] + (do promise.monad + [? (\ fs file? path)] + (if ? + (wrap (#try.Success path)) + (find_source_file fs importer contexts' module extension)))))) (def: (full_host_extension partial_host_extension) (-> Extension Extension) (format partial_host_extension ..lux_extension)) -(def: (find_local_source_file system importer import contexts partial_host_extension module) +(def: (find_local_source_file fs importer import contexts partial_host_extension module) (-> (file.System Promise) Module Import (List Context) Extension Module - (Promise (Try [Path Binary]))) + (Promise (Try [file.Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do {! promise.monad} - [outcome (..find_source_file system importer contexts module (..full_host_extension partial_host_extension))] + [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))] (case outcome - (#try.Success [path file]) - (do (try.with !) - [data (\ file content [])] - (wrap [path data])) + (#try.Success path) + (|> path + (\ fs read) + (\ (try.with !) map (|>> [path]))) (#try.Failure _) - (do (try.with !) - [[path file] (..find_source_file system importer contexts module ..lux_extension) - data (\ file content [])] - (wrap [path data]))))) + (do {! (try.with !)} + [path (..find_source_file fs importer contexts module ..lux_extension)] + (|> path + (\ fs read) + (\ ! map (|>> [path]))))))) (def: (find_library_source_file importer import partial_host_extension module) - (-> Module Import Extension Module (Try [Path Binary])) + (-> Module Import Extension Module (Try [file.Path Binary])) (let [path (format module (..full_host_extension partial_host_extension))] (case (dictionary.get path import) (#.Some data) @@ -107,13 +105,13 @@ #.None (exception.throw ..cannot_find_module [importer module])))))) -(def: (find_any_source_file system importer import contexts partial_host_extension module) +(def: (find_any_source_file fs importer import contexts partial_host_extension module) (-> (file.System Promise) Module Import (List Context) Extension Module - (Promise (Try [Path Binary]))) + (Promise (Try [file.Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do {! promise.monad} - [outcome (find_local_source_file system importer import contexts partial_host_extension module)] + [outcome (find_local_source_file fs importer import contexts partial_host_extension module)] (case outcome (#try.Success [path data]) (wrap outcome) @@ -121,11 +119,11 @@ (#try.Failure _) (wrap (..find_library_source_file importer import partial_host_extension module))))) -(def: #export (read system importer import contexts partial_host_extension module) +(def: #export (read fs importer import contexts partial_host_extension module) (-> (file.System Promise) Module Import (List Context) Extension Module (Promise (Try Input))) (do (try.with promise.monad) - [[path binary] (..find_any_source_file system importer import contexts partial_host_extension module)] + [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)] (case (\ utf8.codec decode binary) (#try.Success code) (wrap {#////.module module @@ -137,53 +135,35 @@ (promise\wrap (exception.throw ..cannot_read_module [module]))))) (type: #export Enumeration - (Dictionary Path Binary)) - -(exception: #export (cannot_clean_path {prefix Path} {path Path}) - (exception.report - ["Prefix" (%.text prefix)] - ["Path" (%.text path)])) - -(def: (clean_path system context path) - (All [!] (-> (file.System !) Context Path (Try Path))) - (let [prefix (format context (\ system separator))] - (case (text.split_with prefix path) - #.None - (exception.throw ..cannot_clean_path [prefix path]) - - (#.Some [_ path]) - (#try.Success path)))) + (Dictionary file.Path Binary)) -(def: (enumerate_context system context enumeration) +(def: (enumerate_context fs directory enumeration) (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) (do {! (try.with promise.monad)} - [directory (\ system directory context)] - (loop [directory directory - enumeration enumeration] - (do ! - [files (\ directory files []) - enumeration (monad.fold ! (function (_ file enumeration) - (let [path (\ file path)] - (if (text.ends_with? ..lux_extension path) - (do ! - [path (promise\wrap (..clean_path system context path)) - source_code (\ file content [])] - (promise\wrap - (dictionary.try_put path source_code enumeration))) - (wrap enumeration)))) - enumeration - files) - directories (\ directory directories [])] - (monad.fold ! recur enumeration directories))))) + [enumeration (|> directory + (\ fs directory_files) + (\ ! map (monad.fold ! (function (_ file enumeration) + (if (text.ends_with? ..lux_extension file) + (do ! + [source_code (\ fs read file)] + (promise\wrap + (dictionary.try_put (file.name fs file) source_code enumeration))) + (wrap enumeration))) + enumeration)) + (\ ! join))] + (|> directory + (\ fs sub_directories) + (\ ! map (monad.fold ! (enumerate_context fs) enumeration)) + (\ ! join)))) (def: Action (type (All [a] (Promise (Try a))))) -(def: #export (enumerate system contexts) +(def: #export (enumerate fs contexts) (-> (file.System Promise) (List Context) (Action Enumeration)) (monad.fold (: (Monad Action) (try.with promise.monad)) - (enumerate_context system) + (..enumerate_context fs) (: Enumeration (dictionary.new text.hash)) contexts)) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index 86cec2ba1..a89bdc836 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -21,9 +21,7 @@ [target [jvm [encoding - ["." name]]]] - [world - ["." file (#+ File Directory)]]] + ["." name]]]]] [program [compositor ["." static (#+ Static)]]] diff --git a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux index 153aa79b5..ac35684ed 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/scheme.lux @@ -24,7 +24,7 @@ [time ["." instant (#+ Instant)]] [world - ["." file (#+ Path File Directory)]]] + ["." file]]] [program [compositor ["." static (#+ Static)]]] @@ -72,7 +72,7 @@ (: _.Expression (_.manual ""))))) (def: module_file - (-> archive.ID Path) + (-> archive.ID file.Path) (|>> %.nat (text.suffix ".scm"))) (def: mode diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index 5ddeac0d5..98a011a4c 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -14,9 +14,7 @@ ["." utf8]]] [collection ["." row] - ["." list ("#\." functor)]]] - [world - ["." file (#+ File Directory)]]] + ["." list ("#\." functor)]]]] [program [compositor ["." static (#+ Static)]]] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 76fb8bc56..400cdacb2 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -5,8 +5,9 @@ [abstract ["." monad (#+ Monad do)]] [control + [pipe (#+ case>)] ["." try (#+ Try) ("#\." functor)] - ["." exception (#+ Exception exception:)] + ["." exception (#+ exception:)] ["." io (#+ IO) ("#\." functor)] ["." function] [concurrency @@ -15,7 +16,7 @@ [data ["." bit ("#\." equivalence)] ["." product] - ["." maybe] + ["." maybe ("#\." functor)] ["." binary (#+ Binary)] ["." text ("#\." equivalence) ["%" format (#+ format)]] @@ -36,161 +37,119 @@ (type: #export Path Text) -(`` (interface: #export (File !) - (: Path - path) +(`` (interface: #export (System !) + (: Text + separator) (~~ (template [<name> <output>] - [(: (-> [] (! (Try <output>))) + [(: (-> Path (! <output>)) <name>)] - [size Nat] - [last_modified Instant] - [can_execute? Bit] - [content Binary] + [file? Bit] + [directory? Bit] )) - (: (-> Path (! (Try (File !)))) - move) - - (~~ (template [<name> <input>] - [(: (-> [<input>] (! (Try Any))) + (~~ (template [<name> <output>] + [(: (-> Path (! (Try <output>))) <name>)] - [modify Instant] - [over_write Binary] - [append Binary] + [make_directory Any] + [directory_files (List Path)] + [sub_directories (List Path)] + + [file_size Nat] + [last_modified Instant] + [can_execute? Bit] + [read Binary] + [delete Any] )) - (: (-> [] (! (Try Any))) - delete) - )) - -(interface: #export (Directory !) - (: Path - scope) - - (: (-> [] (! (Try (List (File !))))) - files) - - (: (-> [] (! (Try (List (Directory !))))) - directories) - - (: (-> [] (! (Try Any))) - discard)) - -(`` (interface: #export (System !) - (~~ (template [<name> <capability>] - [(: (-> Path (! (Try (<capability> !)))) + (~~ (template [<name> <input>] + [(: (-> <input> Path (! (Try Any))) <name>)] - [file File] - [create_file File] - [directory Directory] - [create_directory Directory] + [modify Instant] + [write Binary] + [append Binary] + [move Path] )) - - (: Text - separator) )) -(def: #export (name system path) +(def: #export (un_nest fs path) + (All [!] (-> (System !) Path (Maybe [Path Text]))) + (let [/ (\ fs separator)] + (case (text.last_index_of / path) + #.None + #.None + + (#.Some last_separator) + (do maybe.monad + [[parent temp] (text.split last_separator path) + [_ child] (text.split (text.size /) temp)] + (wrap [parent child]))))) + +(def: #export (parent fs path) + (All [!] (-> (System !) Path (Maybe Path))) + (|> (..un_nest fs path) + (maybe\map product.left))) + +(def: #export (name fs path) (All [!] (-> (System !) Path Text)) - (|> path - (text.split_all_with (\ system separator)) - list.reverse - list.head + (|> (..un_nest fs path) + (maybe\map product.right) (maybe.default path))) -(def: (async_file file) - (-> (File IO) (File Promise)) +(def: #export (async fs) + (-> (System IO) (System Promise)) (`` (implementation - (def: path - (\ file path)) + (def: separator + (\ fs separator)) (~~ (template [<name>] [(def: <name> - (|>> (\ file <name>) promise.future))] + (|>> (\ fs <name>) + promise.future))] - [size] + [file?] + [directory?] + + [make_directory] + [directory_files] + [sub_directories] + + [file_size] [last_modified] [can_execute?] - [content] - [modify] - [over_write] - [append] + [read] [delete])) - (def: move - (|>> (\ file move) - (io\map (try\map async_file)) - promise.future))))) - -(def: (async_directory directory) - (-> (Directory IO) (Directory Promise)) - (`` (implementation - (def: scope - (\ directory scope)) - - (~~ (template [<name> <async>] - [(def: <name> - (|>> (\ directory <name>) - (io\map (try\map (list\map <async>))) - promise.future))] - - [files ..async_file] - [directories async_directory])) - - (def: discard - (|>> (\ directory discard) promise.future))))) - -(def: #export (async system) - (-> (System IO) (System Promise)) - (`` (implementation - (~~ (template [<name> <async>] - [(def: <name> - (|>> (\ system <name>) - (io\map (try\map <async>)) - promise.future))] - - [file ..async_file] - [create_file ..async_file] - [directory ..async_directory] - [create_directory ..async_directory])) + (~~ (template [<name>] + [(def: (<name> input path) + (promise.future (\ fs <name> input path)))] - (def: separator (\ system separator))))) + [modify] + [write] + [append] + [move])) + ))) -(def: #export (un_nest system file) - (All [!] (-> (System !) Path (Maybe [Path Text]))) - (case (text.last_index_of (\ system separator) file) - #.None - #.None - - (#.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])))) - -(def: #export (nest system [parent child]) - (All [!] (-> (System !) [Path Text] Path)) - (format parent (\ system separator) child)) +(def: #export (nest fs parent child) + (All [!] (-> (System !) Path Text Path)) + (format parent (\ fs separator) child)) (template [<name>] [(exception: #export (<name> {file Path}) (exception.report ["Path" file]))] - [cannot_create_file] + [cannot_make_file] [cannot_find_file] - [cannot_delete_file] - [not_a_file] + [cannot_delete] - [cannot_create_directory] + [cannot_make_directory] [cannot_find_directory] - [cannot_discard_directory] [cannot_read_all_data] - [not_a_directory] ) (with_expansions [<extra> (as_is (exception: #export (cannot_move {target Path} {source Path}) @@ -202,7 +161,7 @@ @.lua (as_is <extra>)} (as_is))) -(with_expansions [<for_jvm> (as_is (exception: #export (cannot_modify {instant Instant} {file Path}) +(with_expansions [<for_jvm> (as_is (exception: #export (cannot_modify_file {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] ["Path" file])) @@ -216,7 +175,7 @@ [(<name> [] #io #try boolean)] [createNewFile] [mkdir] - [exists] [delete] + [delete] [isFile] [isDirectory] [canRead] [canWrite] [canExecute])) @@ -228,16 +187,6 @@ (setLastModified [long] #io #try boolean) (#static separator java/lang/String)])) - (template: (!delete path exception) - (do io.monad - [outcome (java/io/File::delete (java/io/File::new path))] - (case outcome - (#try.Success #1) - (wrap (#try.Success [])) - - _ - (wrap (exception.throw exception [path]))))) - (ffi.import: java/lang/AutoCloseable ["#::." (close [] #io #try void)]) @@ -259,86 +208,29 @@ ["#::." (new [java/io/File] #io #try)]) - (`` (implementation: (file path) - (-> Path (File IO)) - - (~~ (template [<name> <flag>] - [(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] - )) + (`` (implementation: #export default + (System IO) - (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: separator + (java/io/File::separator)) - (def: path - path) + (~~ (template [<name> <method>] + [(def: <name> + (|>> java/io/File::new + <method> + (io\map (|>> (try.default false)))))] - (def: (size _) - (|> path - java/io/File::new - java/io/File::length - (\ (try.with io.monad) map .nat))) + [file? java/io/File::isFile] + [directory? java/io/File::isDirectory] + )) - (def: (last_modified _) + (def: (make_directory path) (|> path java/io/File::new - (java/io/File::lastModified) - (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))) + java/io/File::mkdir)) - (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 - path) - - (~~ (template [<name> <method> <capability>] - [(def: (<name> _) + (~~ (template [<name> <method>] + [(def: (<name> path) (do {! (try.with io.monad)} [?children (java/io/File::listFiles (java/io/File::new path))] (case ?children @@ -346,41 +238,68 @@ (|> children array.to_list (monad.filter ! (|>> <method>)) - (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>)))) + (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath))) (\ ! join)) #.None - (\ io.monad wrap (exception.throw ..not_a_directory [path])))))] + (\ io.monad wrap (exception.throw ..cannot_find_directory [path])))))] - [files java/io/File::isFile file] - [directories java/io/File::isDirectory directory] + [directory_files java/io/File::isFile] + [sub_directories java/io/File::isDirectory] )) - (def: (discard _) - (!delete path cannot_discard_directory)))) + (def: file_size + (|>> java/io/File::new + java/io/File::length + (\ (try.with io.monad) map .nat))) - (`` (implementation: #export default - (System IO) + (def: last_modified + (|>> java/io/File::new + (java/io/File::lastModified) + (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))) + + (def: can_execute? + (|>> java/io/File::new + java/io/File::canExecute)) + + (def: (read path) + (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: (delete path) + (|> path + java/io/File::new + java/io/File::delete)) + + (def: (modify time_stamp path) + (|> path + java/io/File::new + (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis)))) - (~~ (template [<name> <method> <capability> <exception>] - [(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] - [directory java/io/File::isDirectory ..directory cannot_find_directory] - [create_directory java/io/File::mkdir ..directory cannot_create_directory] + (~~ (template [<name> <flag>] + [(def: (<name> data path) + (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)))] + + [write #0] + [append #1] )) - (def: separator (java/io/File::separator)) + (def: (move destination origin) + (|> origin + java/io/File::new + (java/io/File::renameTo (java/io/File::new destination)))) )))] (for {@.old (as_is <for_jvm>) @.jvm (as_is <for_jvm>) @@ -451,148 +370,118 @@ (-> [] <type>) (:coerce <type> (..require [] <module>)))] - [node_fs "fs" ..Fs] + [node_fs "fs" ..Fs] [node_path "path" ..JsPath] ) - (`` (implementation: (file path) - (-> Path (File IO)) + (`` (implementation: #export default + (System IO) + + (def: separator + (if ffi.on_node_js? + (JsPath::sep (..node_path [])) + "/")) (~~ (template [<name> <method>] - [(def: (<name> data) - (<method> [path (Buffer::from data)] (..node_fs [])))] + [(def: (<name> path) + (do {! io.monad} + [?stats (Fs::statSync [path] (..node_fs []))] + (case ?stats + (#try.Success stats) + (|> stats + (<method> []) + (\ ! map (|>> (try.default false)))) + + (#try.Failure _) + (wrap false))))] - [over_write Fs::writeFileSync] - [append Fs::appendFileSync] + [file? Stats::isFile] + [directory? Stats::isDirectory] )) - (def: (content _) - (Fs::readFileSync [path] (..node_fs []))) + (def: (make_directory 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 ..cannot_make_directory [path])) + + (#try.Failure _) + (Fs::mkdirSync [path] node_fs))))) - (def: path - path) + (~~ (template [<name> <method>] + [(def: (<name> path) + (do {! (try.with io.monad)} + [#let [node_fs (..node_fs [])] + subs (Fs::readdirSync [path] node_fs)] + (|> subs + array.to_list + (monad.map ! (function (_ sub) + (do ! + [stats (Fs::statSync [sub] node_fs)] + (\ ! map (|>> [sub]) (<method> [] stats))))) + (\ ! map (|>> (list.filter product.right) + (list\map product.left))))))] + + [directory_files Stats::isFile] + [sub_directories Stats::isDirectory] + )) - (def: (size _) - (do (try.with io.monad) - [stat (Fs::statSync [path] (..node_fs []))] - (wrap (|> stat - Stats::size - f.nat)))) + (def: (file_size path) + (let [! (try.with io.monad)] + (|> (..node_fs []) + (Fs::statSync [path]) + (\ ! map (|>> Stats::size + f.nat))))) + + (def: (last_modified path) + (let [! (try.with io.monad)] + (|> (..node_fs []) + (Fs::statSync [path]) + (\ ! map (|>> Stats::mtimeMs + f.int + duration.from_millis + instant.absolute))))) - (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 _) + (def: (can_execute? path) + (let [node_fs (..node_fs [])] + (|> node_fs + (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)]) + (io\map (|>> (case> (#try.Success _) true (#try.Failure _) - false)))))) + false) + #try.Success))))) - (def: (move destination) - (do (try.with io.monad) - [_ (Fs::renameSync [path destination] (..node_fs []))] - (wrap (file destination)))) + (def: (read path) + (Fs::readFileSync [path] (..node_fs []))) + + (def: (delete path) + (do {! (try.with io.monad)} + [#let [node_fs (..node_fs [])] + stats (Fs::statSync [path] node_fs) + verdict (Stats::isFile [] stats)] + (if verdict + (Fs::unlink [path] node_fs) + (Fs::rmdirSync [path] node_fs)))) - (def: (modify time_stamp) + (def: (modify time_stamp path) (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 - path) - - (~~ (template [<name> <method> <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 _) - (Fs::rmdirSync [path] (..node_fs []))))) + (~~ (template [<name> <method>] + [(def: (<name> data path) + (<method> [path (Buffer::from data)] (..node_fs [])))] - (`` (implementation: #export default - (System IO) - - (~~ (template [<name> <method> <capability> <exception>] - [(with_expansions [<failure> (exception.throw <exception> [path])] - (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] + [write Fs::writeFileSync] + [append Fs::appendFileSync] )) - (~~ (template [<name> <capability> <exception> <prep>] - [(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])] - )) - - (def: separator - (if ffi.on_node_js? - (JsPath::sep (..node_path [])) - "/")) - )) - ) + (def: (move destination origin) + (Fs::renameSync [origin destination] (..node_fs []))) + ))) @.python (as_is (type: (Tuple/2 left right) @@ -630,366 +519,85 @@ (#static getsize [ffi.String] #io #try ffi.Integer) (#static getmtime [ffi.String] #io #try ffi.Float)]) - (`` (implementation: (file path) - (-> Path (File IO)) - - (~~ (template [<name> <mode>] - [(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 _) - (do (try.with io.monad) - [file (..open [path "rb"]) - data (PyFile::read [] file) - _ (PyFile::close [] file)] - (wrap data))) - - (def: 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 - path) - - (~~ (template [<name> <method> <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 _) - (os::rmdir [path])) - )) - (`` (implementation: #export default (System IO) - (~~ (template [<name> <method> <capability> <exception>] - [(with_expansions [<failure> (exception.throw <exception> [path])] - (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 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)) - )) - ) - - @.lua - (as_is (ffi.import: LuaFile - ["#::." - (read [ffi.String] #io ffi.String) - (write [ffi.String] #io #? LuaFile) - (flush [] #io ffi.Boolean) - (close [] #io ffi.Boolean)]) - - (ffi.import: (io/open [ffi.String ffi.String] #io #? LuaFile)) - (ffi.import: (package/config ffi.String)) - - (ffi.import: (os/rename [ffi.String ffi.String] #io #? ffi.Boolean)) - (ffi.import: (os/remove [ffi.String] #io #? ffi.Boolean)) - (ffi.import: (os/execute [ffi.String] #io #? ffi.Boolean)) - - (def: default_separator - Text - (|> (package/config) - (text.split_all_with text.new_line) - list.head - (maybe.default "/"))) - - (template [<name>] - [(exception: #export (<name> {file Path}) - (exception.report - ["Path" file]))] - - [cannot_open_file] - [cannot_close_file] - [cannot_write_to_file] - [file_already_exists] - ) - - (exception: #export (invalid_operation {signature Name} {operation Text}) - (exception.report - ["Platform" @.lua] - ["Signature" (%.name signature)] - ["Operation" (%.text operation)])) - - (`` (implementation: (file path) - (-> Path (File IO)) + (~~ (template [<name> <method>] + [(def: <name> + (|>> <method> + (io\map (|>> (try.default false)))))] - (~~ (template [<name> <mode>] - [(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"] + [file? os/path::isfile] + [directory? os/path::isdir] )) - (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: make_directory + os::mkdir) - (def: path - path) + (~~ (template [<name> <method>] + [(def: <name> + (let [! (try.with io.monad)] + (|>> os::listdir + (\ ! map (|>> array.to_list + (monad.map ! (function (_ sub) + (\ ! map (|>> [sub]) (<method> [sub])))) + (\ ! map (|>> (list.filter product.right) + (list\map product.left))))) + (\ ! join))))] + + [directory_files os/path::isfile] + [sub_directories os/path::isdir] + )) - (~~ (template [<name>] - [(def: (<name> _) - (let [[_ short] (name_of <name>)] - (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))] + (def: file_size + (|>> os/path::getsize + (\ (try.with io.monad) map .nat))) - [size] - [last_modified] - [can_execute?] + (def: last_modified + (|>> os/path::getmtime + (\ (try.with io.monad) map (|>> f.int + (i.* +1,000) + duration.from_millis + instant.absolute)))) - [modify] - )) + (def: (can_execute? path) + (os::access [path (os::X_OK)])) - (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 - path) - - (~~ (template [<name>] - [(def: (<name> _) - (let [[_ short] (name_of <name>)] - (\ io.monad wrap (exception.throw ..invalid_operation [(name_of ..File) short]))))] - - [files] - [directories] - )) + (def: (read path) + (do (try.with io.monad) + [file (..open [path "rb"]) + data (PyFile::read [] file) + _ (PyFile::close [] file)] + (wrap data))) - (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) - (-> Path (IO (Try (File IO)))) - (do {! io.monad} - [?file (io/open [path "r"])] - (case ?file - (#try.Success file) - (do ! - [closed? (LuaFile::close [] file)] - (wrap (if closed? - (#try.Success (..file path)) - (exception.throw ..cannot_close_file [path])))) - - (#try.Failure _) - (wrap (exception.throw ..cannot_find_file [path]))))) - - (def: (default_create_file path) - (-> Path (IO (Try (File IO)))) - (do {! io.monad} - [?file (..default_file path)] - (case ?file - (#try.Failure _) - (do {! io.monad} - [?file (io/open [path "w+b"])] - (case ?file - (#.Some file) - (do ! - [closed? (LuaFile::close [] file)] - (wrap (if closed? - (#try.Success (..file path)) - (exception.throw ..cannot_close_file [path])))) - - #.None - (wrap (exception.throw ..cannot_create_file [path])))) - - (#try.Success file) - (wrap (exception.throw ..file_already_exists [path]))))) + (def: (delete path) + (do (try.with io.monad) + [? (os/path::isfile [path])] + (if ? + (os::remove [path]) + (os::rmdir [path])))) - (`` (implementation: #export default - (System IO) + (def: (modify time_stamp path) + (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))] + (os::utime [path (..tuple [when when])]))) - (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))) + (~~ (template [<name> <mode>] + [(def: (<name> data path) + (do (try.with io.monad) + [file (..open [path <mode>]) + _ (PyFile::write [data] file)] + (PyFile::close [] file)))] - (#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]))))) + [write "w+b"] + [append "ab"] + )) - (def: separator - ..default_separator) - )) - ) + (def: (move destination origin) + (os::rename [origin destination])) + ))) @.ruby (as_is (ffi.import: Time #as RubyTime @@ -1027,95 +635,41 @@ (ffi.import: "fileutils" FileUtils #as RubyFileUtils ["#::." - (#static touch [Path] #io #try #? Any) (#static move [Path Path] #io #try #? Any) (#static rmdir [Path] #io #try #? Any) (#static mkdir [Path] #io #try #? Any)]) - (def: default_separator + (def: ruby_separator Text (..RubyFile::SEPARATOR)) - (`` (implementation: (file path) - (-> Path (File IO)) - - (~~ (template [<name> <mode>] - [(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 _) - (do {! (try.with io.monad)} - [file (RubyFile::open [path "rb"]) - data (RubyFile::read [] file) - _ (RubyFile::close [] file)] - (wrap data))) + (`` (implementation: #export default + (System IO) - (def: path - path) + (def: separator + ..ruby_separator) - (~~ (template [<name> <pipeline>] - [(def: (<name> _) - (do {! (try.with io.monad)} - [stat (: (IO (Try RubyStat)) - (RubyFile::stat [path]))] - (wrap (`` (|> stat (: RubyStat) (~~ (template.splice <pipeline>)))))))] + (~~ (template [<name> <test>] + [(def: <name> + (|>> <test> + (io\map (|>> (try.default false)))))] - [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? [])]] + [file? RubyFile::file?] + [directory? RubyFile::directory?] )) + + (def: make_directory + RubyFileUtils::mkdir) - (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 - path) - - (~~ (template [<name> <test> <constructor> <capability>] - [(def: (<name> _) + (~~ (template [<name> <test>] + [(def: (<name> path) (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\map (|>> (format path ..ruby_separator)))) + output (: (List ..Path) (list))] (case input #.Nil @@ -1124,278 +678,265 @@ (#.Cons head tail) (do ! [verdict (<test> head)] - (if verdict - (recur tail (#.Cons (<constructor> head) output)) - (recur tail output))))) + (recur tail (if verdict + (#.Cons head output) + output))))) _ (RubyDir::close [] self)] (wrap output)))] - [files RubyFile::file? ..file File] - [directories RubyFile::directory? directory Directory] - )) - - (def: (discard _) - (do (try.with io.monad) - [_ (RubyFileUtils::rmdir [path])] - (wrap []))) - )) - - (`` (implementation: #export default - (System IO) - - (~~ (template [<name> <test> <constructor> <exception>] - [(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] + [directory_files RubyFile::file?] + [sub_directories RubyFile::directory?] )) - - (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) - )) - ) - - @.php - (as_is (ffi.import: (FILE_APPEND Int)) - ## https://www.php.net/manual/en/dir.constants.php - (ffi.import: (DIRECTORY_SEPARATOR ffi.String)) - ## https://www.php.net/manual/en/function.pack.php - ## https://www.php.net/manual/en/function.unpack.php - (ffi.import: (unpack [ffi.String ffi.String] Binary)) - ## https://www.php.net/manual/en/ref.filesystem.php - ## https://www.php.net/manual/en/function.file-get-contents.php - (ffi.import: (file_get_contents [Path] #io #try ffi.String)) - ## https://www.php.net/manual/en/function.file-put-contents.php - (ffi.import: (file_put_contents [Path ffi.String Int] #io #try ffi.Integer)) - (ffi.import: (filemtime [Path] #io #try ffi.Integer)) - (ffi.import: (filesize [Path] #io #try ffi.Integer)) - (ffi.import: (is_executable [Path] #io #try ffi.Boolean)) - (ffi.import: (touch [Path ffi.Integer] #io #try ffi.Boolean)) - (ffi.import: (rename [Path Path] #io #try ffi.Boolean)) - (ffi.import: (unlink [Path] #io #try ffi.Boolean)) - - ## https://www.php.net/manual/en/function.rmdir.php - (ffi.import: (rmdir [Path] #io #try ffi.Boolean)) - ## https://www.php.net/manual/en/function.scandir.php - (ffi.import: (scandir [Path] #io #try (Array Path))) - ## https://www.php.net/manual/en/function.is-file.php - (ffi.import: (is_file [Path] #io #try ffi.Boolean)) - ## https://www.php.net/manual/en/function.is-dir.php - (ffi.import: (is_dir [Path] #io #try ffi.Boolean)) - ## https://www.php.net/manual/en/function.mkdir.php - (ffi.import: (mkdir [Path] #io #try ffi.Boolean)) - - (def: byte_array_format "C*") - (def: default_separator (..DIRECTORY_SEPARATOR)) - - (template [<name>] - [(exception: #export (<name> {file Path}) - (exception.report - ["Path" file]))] - - [cannot_write_to_file] - ) - - (`` (implementation: (file path) - (-> Path (File IO)) - - (~~ (template [<name> <mode>] - [(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 _) - (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 - 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>))))))))] + (~~ (template [<name> <pipeline>] + [(def: <name> + (let [! (try.with io.monad)] + (|>> RubyFile::stat + (\ ! map (`` (|>> (~~ (template.splice <pipeline>))))))))] - [size ..filesize [.nat]] - [last_modified ..filemtime [(i.* +1,000) duration.from_millis instant.absolute]] + [file_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: (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 _) + (def: (read path) (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 - path) - - (~~ (template [<name> <test> <constructor> <capability>] - [(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] - )) + [file (RubyFile::open [path "rb"]) + data (RubyFile::read [] file) + _ (RubyFile::close [] file)] + (wrap data))) - (def: (discard _) + (def: (delete path) (do (try.with io.monad) - [verdict (..rmdir [path])] - (if (bit\= false (:coerce Bit verdict)) - (\ io.monad wrap (exception.throw ..cannot_find_directory [path])) - (wrap [])))) - )) + [? (RubyFile::file? path)] + (if ? + (RubyFile::delete [path]) + (RubyFileUtils::rmdir [path])))) - (`` (implementation: #export default - (System IO) + (def: (modify moment path) + (let [moment (|> moment + instant.relative + duration.to_millis + i.frac + (f./ +1,000.0) + RubyTime::at)] + (RubyFile::utime [moment moment path]))) - (~~ (template [<name> <test> <constructor> <exception>] - [(def: (<name> path) + (~~ (template [<mode> <name>] + [(def: (<name> data 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] + [file (RubyFile::open [path <mode>]) + data (RubyFile::write [data] file) + _ (RubyFile::flush [] file) + _ (RubyFile::close [] file)] + (wrap [])))] + + ["wb" write] + ["ab" append] )) - (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 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) - )) - ) + (def: (move destination origin) + (do (try.with io.monad) + [_ (RubyFileUtils::move [origin destination])] + (wrap []))) + ))) + + ## @.php + ## (as_is (ffi.import: (FILE_APPEND Int)) + ## ## https://www.php.net/manual/en/dir.constants.php + ## (ffi.import: (DIRECTORY_SEPARATOR ffi.String)) + ## ## https://www.php.net/manual/en/function.pack.php + ## ## https://www.php.net/manual/en/function.unpack.php + ## (ffi.import: (unpack [ffi.String ffi.String] Binary)) + ## ## https://www.php.net/manual/en/ref.filesystem.php + ## ## https://www.php.net/manual/en/function.file-get-contents.php + ## (ffi.import: (file_get_contents [Path] #io #try ffi.String)) + ## ## https://www.php.net/manual/en/function.file-put-contents.php + ## (ffi.import: (file_put_contents [Path ffi.String Int] #io #try ffi.Integer)) + ## (ffi.import: (filemtime [Path] #io #try ffi.Integer)) + ## (ffi.import: (filesize [Path] #io #try ffi.Integer)) + ## (ffi.import: (is_executable [Path] #io #try ffi.Boolean)) + ## (ffi.import: (touch [Path ffi.Integer] #io #try ffi.Boolean)) + ## (ffi.import: (rename [Path Path] #io #try ffi.Boolean)) + ## (ffi.import: (unlink [Path] #io #try ffi.Boolean)) + + ## ## https://www.php.net/manual/en/function.rmdir.php + ## (ffi.import: (rmdir [Path] #io #try ffi.Boolean)) + ## ## https://www.php.net/manual/en/function.scandir.php + ## (ffi.import: (scandir [Path] #io #try (Array Path))) + ## ## https://www.php.net/manual/en/function.is-file.php + ## (ffi.import: (is_file [Path] #io #try ffi.Boolean)) + ## ## https://www.php.net/manual/en/function.is-dir.php + ## (ffi.import: (is_dir [Path] #io #try ffi.Boolean)) + ## ## https://www.php.net/manual/en/function.mkdir.php + ## (ffi.import: (mkdir [Path] #io #try ffi.Boolean)) + + ## (def: byte_array_format "C*") + ## (def: default_separator (..DIRECTORY_SEPARATOR)) + + ## (template [<name>] + ## [(exception: #export (<name> {file Path}) + ## (exception.report + ## ["Path" file]))] + + ## [cannot_write_to_file] + ## ) + + ## (`` (implementation: (file path) + ## (-> Path (File IO)) + + ## (~~ (template [<name> <mode>] + ## [(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 _) + ## (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 + ## 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? _) + ## (..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 + ## path) + + ## (~~ (template [<name> <test> <constructor> <capability>] + ## [(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 _) + ## (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> 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: (make_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_make_file [path]))))) + + ## (def: (make_directory path) + ## (do {! (try.with io.monad)} + ## [verdict (..mkdir path)] + ## (\ io.monad wrap + ## (if verdict + ## (#try.Success (..directory path)) + ## (exception.throw ..cannot_make_directory [path]))))) + + ## (def: separator + ## ..default_separator) + ## )) + ## ) @.scheme (as_is) })) -(template [<get> <signature> <create> <find> <exception>] - [(def: #export (<get> monad system path) - (All [!] (-> (Monad !) (System !) Path (! (Try (<signature> !))))) - (do monad - [outcome (\ system <find> path)] - (case outcome - (#try.Success file) - (wrap (#try.Success file)) - - (#try.Failure error) - (if (exception.match? <exception> error) - (\ 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] - ) - -(template [<predicate> <capability>] - [(def: #export (<predicate> monad system path) - (All [!] (-> (Monad !) (System !) Path (! Bit))) - (do monad - [?file (\ system <capability> path)] - (case ?file - (#try.Success file) - (wrap true) - - (#try.Failure _) - (wrap false))))] - - [file_exists? file] - [directory_exists? directory] - ) - -(def: #export (exists? monad system path) +(def: #export (exists? monad fs path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [verdict (..file_exists? monad system path)] + [verdict (\ fs file? path)] (if verdict (wrap verdict) - (..directory_exists? monad system path)))) + (\ fs directory? path)))) (type: Mock_File {#mock_last_modified Instant @@ -1409,38 +950,6 @@ Mock (dictionary.new text.hash)) -(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)] - (case trail - (#.Cons head tail) - (case (dictionary.get head directory) - #.None - (case tail - #.Nil - (#try.Success [head (dictionary.put head - (#.Left {#mock_last_modified now - #mock_can_execute false - #mock_content (binary.create 0)}) - directory)]) - - (#.Cons _) - (exception.throw ..cannot_create_file [path])) - - (#.Some node) - (case [node tail] - [(#.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)])) - - _ - (exception.throw ..cannot_create_file [path]))) - - #.Nil - (exception.throw ..cannot_create_file [path])))) - (def: (retrieve_mock_file! separator path mock) (-> Text Path Mock (Try [Text Mock_File])) (loop [directory mock @@ -1463,17 +972,26 @@ (exception.throw ..cannot_find_file [path]))) #.Nil - (exception.throw ..not_a_file [path])))) + (exception.throw ..cannot_find_file [path])))) -(def: (update_mock_file! separator path now content mock) +(def: (update_mock_file! / 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 / path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot_find_file [path]) + (case tail + #.Nil + (#try.Success (dictionary.put head + (#.Left {#mock_last_modified now + #mock_can_execute false + #mock_content content}) + directory)) + + (#.Cons _) + (exception.throw ..cannot_find_file [path])) (#.Some node) (case [node tail] @@ -1495,31 +1013,40 @@ #.Nil (exception.throw ..cannot_find_file [path])))) -(def: (delete_mock_file! separator path mock) +(def: (mock_delete! / path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split_all_with separator path)] + trail (text.split_all_with / path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot_delete_file [path]) + (exception.throw ..cannot_delete [path]) (#.Some node) - (case [node tail] - [(#.Left file) #.Nil] - (#try.Success (dictionary.remove head directory)) + (case tail + #.Nil + (case node + (#.Left file) + (#try.Success (dictionary.remove head directory)) - [(#.Right sub_directory) (#.Cons _)] - (do try.monad - [sub_directory (recur sub_directory tail)] - (wrap (dictionary.put head (#.Right sub_directory) directory))) + (#.Right sub_directory) + (if (dictionary.empty? sub_directory) + (#try.Success (dictionary.remove head directory)) + (exception.throw ..cannot_delete [path]))) + + (#.Cons _) + (case node + (#.Left file) + (exception.throw ..cannot_delete [path]) - _ - (exception.throw ..cannot_delete_file [path]))) + (#.Right sub_directory) + (do try.monad + [sub_directory' (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory') directory)))))) #.Nil - (exception.throw ..cannot_delete_file [path])))) + (exception.throw ..cannot_delete [path])))) (def: (try_update! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) @@ -1534,99 +1061,10 @@ (#try.Failure error) (wrap (#try.Failure error))))) -(def: (mock_file separator path store) - (-> Text Path (Var Mock) (File Promise)) - (implementation - (def: path - path) - - (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) +(def: (make_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split_all_with separator path)] + trail (text.split_all_with / path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) @@ -1636,7 +1074,7 @@ (#try.Success (dictionary.put head (#.Right ..empty_mock) directory)) (#.Cons _) - (exception.throw ..cannot_create_directory [path])) + (exception.throw ..cannot_make_directory [path])) (#.Some node) (case [node tail] @@ -1646,205 +1084,221 @@ (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot_create_directory [path]))) + (exception.throw ..cannot_make_directory [path]))) #.Nil - (exception.throw ..cannot_create_directory [path])))) + (exception.throw ..cannot_make_directory [path])))) -(def: (retrieve_mock_directory! separator path mock) +(def: (retrieve_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split_all_with separator path)] + trail (text.split_all_with / path)] (case trail - (#.Cons head tail) - (case (dictionary.get head directory) - #.None - (exception.throw ..cannot_find_directory [path]) - - (#.Some node) - (case [node tail] - [(#.Right sub_directory) #.Nil] - (#try.Success sub_directory) - - [(#.Right sub_directory) (#.Cons _)] - (recur sub_directory tail) - - _ - (exception.throw ..cannot_find_directory [path]))) - #.Nil - (#try.Success directory)))) + (#try.Success directory) -(def: (delete_mock_directory! separator path mock) - (-> Text Path Mock (Try Mock)) - (loop [directory mock - 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_find_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])) - - [(#.Right sub_directory) (#.Cons _)] - (do try.monad - [sub_directory (recur sub_directory tail)] - (wrap (dictionary.put head (#.Right sub_directory) directory))) + (case node + (#.Left _) + (exception.throw ..cannot_find_directory [path]) - _ - (exception.throw ..cannot_discard_directory [path]))) + (#.Right sub_directory) + (case tail + #.Nil + (#try.Success sub_directory) - #.Nil - (exception.throw ..cannot_discard_directory [path])))) - -(def: (mock_directory separator path store) - (-> Text Path (Var Mock) (Directory Promise)) - (implementation - (def: scope - path) - - (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)))))))))))) - - (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)))))) - )) + (#.Cons _) + (recur sub_directory tail))))))) (def: #export (mock separator) (-> Text (System Promise)) (let [store (stm.var ..empty_mock)] - (implementation - (def: separator separator) - - (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) - (All [!] (-> (Monad !) (System !) Path (! (Try Path)))) - (let [rooted? (text.starts_with? (\ system separator) path) - segments (text.split_all_with (\ system separator) path)] + (`` (implementation + (def: separator + separator) + + (~~ (template [<method> <retrieve>] + [(def: (<method> path) + (|> store + stm.read + (\ stm.monad map + (|>> (<retrieve> separator path) + (try\map (function.constant true)) + (try.default false))) + stm.commit))] + + [file? ..retrieve_mock_file!] + [directory? ..retrieve_mock_directory!])) + + (def: (make_directory path) + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (..make_mock_directory! separator path |store|) + (#try.Success |store|) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) + + (~~ (template [<method> <tag>] + [(def: (<method> path) + (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 + (<tag> _) + (#.Some (format path separator node_name)) + + _ + #.None))))))))))] + + [directory_files #.Left] + [sub_directories #.Right] + )) + + (def: (file_size path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_content) + binary.size))))))) + + (def: (last_modified path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_last_modified)))))))) + + (def: (can_execute? path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_can_execute)))))))) + + (def: (read path) + (stm.commit + (do stm.monad + [|store| (stm.read store)] + (wrap (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_content)))))))) + + (def: (delete path) + (stm.commit + (..try_update! (..mock_delete! separator path) store))) + + (def: (modify now path) + (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: (write content path) + (do promise.monad + [now (promise.future instant.now)] + (stm.commit + (..try_update! (..update_mock_file! separator path now content) store)))) + + (def: (append content path) + (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: (move destination origin) + (stm.commit + (do {! stm.monad} + [|store| (stm.read store)] + (case (do try.monad + [[name file] (..retrieve_mock_file! separator origin |store|) + |store| (..mock_delete! separator origin |store|)] + (..update_mock_file! separator destination (get@ #mock_last_modified file) (get@ #mock_content file) |store|)) + (#try.Success |store|) + (do ! + [_ (stm.write |store| store)] + (wrap (#try.Success []))) + + (#try.Failure error) + (wrap (#try.Failure error)))))) + )))) + +(def: (check_or_make_directory monad fs path) + (All [!] (-> (Monad !) (System !) Path (! (Try Any)))) + (do monad + [? (\ fs directory? path)] + (if ? + (wrap (#try.Success [])) + (\ fs make_directory path)))) + +(def: #export (make_directories monad fs path) + (All [!] (-> (Monad !) (System !) Path (! (Try Any)))) + (let [rooted? (text.starts_with? (\ fs separator) path) + segments (text.split_all_with (\ fs separator) path)] (case (if rooted? (list.drop 1 segments) segments) #.Nil - (\ monad wrap (exception.throw ..cannot_create_directory [path])) + (\ monad wrap (exception.throw ..cannot_make_directory [path])) (#.Cons head tail) - (loop [current (if rooted? - (format (\ system separator) head) - head) - next tail] - (do monad - [? (..get_directory monad system current)] - (case ? - (#try.Success _) - (case next - #.Nil - (wrap (#try.Success current)) - - (#.Cons head tail) - (recur (format current (\ system separator) head) - tail)) - - (#try.Failure error) - (wrap (#try.Failure error)))))))) - -(def: #export (parent system path) - (All [!] (-> (System !) Path Path)) - (let [/ (\ system separator)] - (|> path - (text.split_all_with /) - list.inits - (maybe.default (list)) - (text.join_with /)))) + (case head + "" (\ monad wrap (exception.throw ..cannot_make_directory [path])) + _ (loop [current (if rooted? + (format (\ fs separator) head) + head) + next tail] + (do monad + [? (..check_or_make_directory monad fs current)] + (case ? + (#try.Success _) + (case next + #.Nil + (wrap (#try.Success [])) + + (#.Cons head tail) + (recur (format current (\ fs separator) head) + tail)) + + (#try.Failure error) + (wrap (#try.Failure error))))))))) + +(def: #export (make_file monad fs content path) + (All [!] (-> (Monad !) (System !) Binary Path (! (Try Any)))) + (do monad + [? (\ fs file? path)] + (if ? + (wrap (exception.throw ..cannot_make_file [path])) + (\ fs write content path)))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 85ae21b2f..488f40e02 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -86,65 +86,68 @@ concern) (: (-> //.Path (! (Try Concern))) stop) - (: (-> [] (! (Try (List [//.Path Concern])))) + (: (-> [] (! (Try (List [Concern //.Path])))) poll)) -(exception: #export (not_being_watched {path //.Path}) - (exception.report - ["Path" (%.text path)])) +(template [<name>] + [(exception: #export (<name> {path //.Path}) + (exception.report + ["Path" (%.text path)]))] + + [not_being_watched] + [cannot_poll_a_non_existent_directory] + ) (type: File_Tracker - (Dictionary //.Path [(//.File Promise) Instant])) + (Dictionary //.Path Instant)) (type: Directory_Tracker - (Dictionary //.Path [Concern (//.Directory Promise) File_Tracker])) + (Dictionary //.Path [Concern File_Tracker])) (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 last_modified]) (do ! - [_ (stm.update (dictionary.put path [new_concern file last_modified]) tracker)] + [_ (stm.update (dictionary.put path [new_concern last_modified]) tracker)] (wrap true)) #.None (wrap false)))) (def: (file_tracker fs directory) - (-> (//.System Promise) (//.Directory Promise) (Promise (Try File_Tracker))) + (-> (//.System Promise) //.Path (Promise (Try File_Tracker))) (do {! (try.with promise.monad)} - [files (\ directory files [])] + [files (\ fs directory_files directory)] (monad.fold ! (function (_ file tracker) (do ! - [last_modified (\ file last_modified [])] - (wrap (dictionary.put (\ file path) - [file last_modified] - tracker)))) + [last_modified (\ fs last_modified file)] + (wrap (dictionary.put file last_modified 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 fs directory) + (-> (//.System Promise) //.Path (Promise (Try (List [//.Path Instant])))) (do {! (try.with promise.monad)} - [files (\ directory files [])] + [files (\ fs directory_files directory)] (monad.map ! (function (_ file) - (do ! - [last_modified (\ file last_modified [])] - (wrap [(\ file path) file last_modified]))) + (|> file + (\ fs last_modified) + (\ ! map (|>> [file])))) files))) -(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]) +(def: (poll_directory_changes fs [directory [concern file_tracker]]) + (-> (//.System Promise) [//.Path [Concern File_Tracker]] + (Promise (Try [[//.Path [Concern File_Tracker]] + [(List [//.Path Instant]) (List [//.Path Instant Instant]) - (List [//.Path])]]))) + (List //.Path)]]))) (do {! (try.with promise.monad)} - [current_files (..poll_files directory file_tracker) + [current_files (..poll_files fs directory) #let [creations (if (..creation? concern) (list.filter (|>> product.left (dictionary.key? file_tracker) not) current_files) @@ -157,24 +160,20 @@ (list\map product.left) (list.filter (|>> (set.member? available) not))) (list)) - modifications (list.all (function (_ [path file current_modification]) + modifications (list.all (function (_ [path current_modification]) (do maybe.monad - [[_ previous_modification] (dictionary.get path file_tracker)] + [previous_modification (dictionary.get path file_tracker)] (wrap [path previous_modification current_modification]))) current_files)]] - (wrap [[path + (wrap [[directory [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_creations (list\fold (function (_ [path last_modified] tracker) + (dictionary.put path last_modified tracker)) with_deletions creations) with_modifications (list\fold (function (_ [path previous_modification current_modification] tracker) - (dictionary.update path - (function (_ [file _]) - [file current_modification]) - tracker)) + (dictionary.put path current_modification tracker)) with_creations modifications)] with_modifications)]] @@ -189,21 +188,24 @@ (implementation (def: (start new_concern path) (do {! promise.monad} - [updated? (stm.commit (..update_watch! new_concern path tracker))] - (if updated? - (wrap (#try.Success [])) - (do (try.with !) - [directory (\ fs directory path) - file_tracker (..file_tracker fs directory)] - (do ! - [_ (stm.commit (stm.update (dictionary.put path [new_concern directory file_tracker]) tracker))] - (wrap (#try.Success []))))))) + [exists? (\ fs directory? path)] + (if exists? + (do ! + [updated? (stm.commit (..update_watch! new_concern path tracker))] + (if updated? + (wrap (#try.Success [])) + (do (try.with !) + [file_tracker (..file_tracker fs path)] + (do ! + [_ (stm.commit (stm.update (dictionary.put path [new_concern file_tracker]) tracker))] + (wrap (#try.Success [])))))) + (wrap (exception.throw ..cannot_poll_a_non_existent_directory [path]))))) (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 file_tracker]) (#try.Success concern) #.None @@ -213,7 +215,7 @@ (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.get path @tracker) - (#.Some [concern directory file_tracker]) + (#.Some [concern file_tracker]) (do ! [_ (stm.update (dictionary.remove path) tracker)] (wrap (#try.Success concern))) @@ -226,7 +228,7 @@ (do {! (try.with promise.monad)} [changes (|> @tracker dictionary.entries - (monad.map ! ..poll_directory_changes)) + (monad.map ! (..poll_directory_changes fs))) _ (do promise.monad [_ (stm.commit (stm.write (|> changes (list\map product.left) @@ -242,13 +244,12 @@ [(list) (list) (list)] changes)]] (wrap ($_ list\compose - (list\map (function (_ [path file last_modification]) [path ..creation]) creations) + (list\map (|>> product.left [..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]) - [path ..modification]))) - (list\map (function (_ path) [path ..deletion]) deletions) + (list\map (|>> product.left [..modification]))) + (list\map (|>> [..deletion]) deletions) ))))) ))) @@ -267,7 +268,7 @@ (size [] int) (get [int] a)]) - (def: (default\\list list) + (def: (default_list list) (All [a] (-> (java/util/List a) (List a))) (let [size (.nat (java/util/List::size list))] (loop [idx 0 @@ -297,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) @@ -325,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) + (\ io.monad map (|>> ..default_list + (list\map default_event_concern) (list\fold ..also ..none))))) (import: java/nio/file/WatchService @@ -352,7 +353,7 @@ (type: Watch_Event (java/nio/file/WatchEvent$Kind java/lang/Object)) - (def: (default\\start watch_events watcher path) + (def: (default_start watch_events watcher path) (-> (List Watch_Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) (let [watch_events' (list\fold (function (_ [index watch_event] watch_events') (ffi.array_write index watch_event watch_events')) @@ -364,9 +365,9 @@ watch_events' (|> path java/io/File::new java/io/File::toPath))))) - (def: (default\\poll watcher) - (-> java/nio/file/WatchService (IO (Try (List [//.Path Concern])))) - (loop [output (: (List [//.Path Concern]) + (def: (default_poll watcher) + (-> java/nio/file/WatchService (IO (Try (List [Concern //.Path])))) + (loop [output (: (List [Concern //.Path]) (list))] (do (try.with io.monad) [?key (java/nio/file/WatchService::poll watcher)] @@ -381,8 +382,8 @@ (:coerce java/nio/file/Path) java/nio/file/Path::toString (:coerce //.Path))] - concern (..default\\key_concern key)] - (recur (#.Cons [path concern] + concern (..default_key_concern key)] + (recur (#.Cons [concern path] output))) (recur output))) @@ -431,10 +432,10 @@ (do promise.monad [?concern (stop path)] (do (try.with promise.monad) - [key (..default\\start (..watch_events (..also (try.default ..none ?concern) - concern)) - watcher - path)] + [key (..default_start (..watch_events (..also (try.default ..none ?concern) + concern)) + watcher + path)] (do promise.monad [_ (stm.commit (stm.update (dictionary.put path [concern key]) tracker))] (wrap (#try.Success [])))))) @@ -449,7 +450,7 @@ (wrap (exception.throw ..not_being_watched [path]))))) (def: stop stop) (def: (poll _) - (promise.future (..default\\poll watcher))) + (promise.future (..default_poll watcher))) ))))) )] (for {@.old (as_is <jvm>) diff --git a/stdlib/source/lux/world/net/http/client.lux b/stdlib/source/lux/world/net/http/client.lux index ad11a10ab..eae724365 100644 --- a/stdlib/source/lux/world/net/http/client.lux +++ b/stdlib/source/lux/world/net/http/client.lux @@ -202,7 +202,8 @@ {#//.headers headers #//.body (..default_body input)}]))))))] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + @.jvm (as_is <jvm>)} + (as_is))) (implementation: #export (async client) (-> (Client IO) (Client Promise)) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 5f3d95631..398fb26cf 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -13,32 +13,26 @@ [world [program (#+ Program)] [shell (#+ Shell)] - ["." console (#+ Console)] - ["." file (#+ Path) + [console (#+ Console)] + ["." file ["." watch (#+ Watcher)]]]] ["." // #_ ["/#" // #_ [command (#+ Command)] ["#" profile] - ["#." action (#+ Action)] + ["#." action] [dependency [resolution (#+ Resolution)]]]]) (def: (targets fs path) - (-> (file.System Promise) Path (Promise (List Path))) - (do {! promise.monad} - [?root (\ fs directory [path])] - (case ?root - (#try.Success root) - (loop [root root] - (do ! - [subs (\ ! map (|>> (try.default (list))) - (\ root directories []))] - (\ ! map (|>> list.concat (list& (\ root scope))) - (monad.map ! recur subs)))) - - (#try.Failure error) - (wrap (list))))) + (-> (file.System Promise) file.Path (Promise (List file.Path))) + (let [! promise.monad] + (|> path + (\ fs sub_directories) + (\ ! map (|>> (try.default (list)) + (monad.map ! (targets fs)))) + (\ ! join) + (\ ! map (|>> list.concat (list& path)))))) (def: #export delay Nat @@ -68,13 +62,12 @@ (loop [_ []] (do ! [_ (..pause delay) - events (\ watcher poll []) - _ (case events - (#.Cons _) - (do ! - [_ <call>] - (wrap [])) + events (\ watcher poll [])] + (case events + (#.Cons _) + (do ! + [_ <call>] + (recur [])) - #.Nil - (wrap []))] - (recur []))))))))) + #.Nil + (recur [])))))))))) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index 142451113..c37c46367 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -3,54 +3,46 @@ [abstract ["." monad (#+ do)]] [control - ["." try (#+ Try)] - ["." exception] + [try (#+ Try)] [concurrency ["." promise (#+ Promise)]]] [data [text ["%" format (#+ format)]]] [world - ["." file (#+ Path File Directory)] + ["." file (#+ Path)] ["." console (#+ Console)]]] ["." /// #_ [command (#+ Command)] ["#" profile] ["#." action (#+ Action)]]) -(def: (clean_files! root) - (-> (Directory Promise) (Promise (Try Any))) - (do {! ///action.monad} - [nodes (: (Promise (Try (List (File Promise)))) - (\ root files [])) - _ (monad.map ! (function (_ node) - (\ node delete [])) - nodes)] - (wrap []))) +(def: (clean_files! fs root) + (-> (file.System Promise) Path (Promise (Try Any))) + (let [! ///action.monad] + (|> root + (\ fs directory_files) + (\ ! map (monad.map ! (\ fs delete))) + (\ ! join)))) -(def: #export (success path) +(def: #export success (-> ///.Target Text) - (format "Successfully cleaned target directory: " path)) + (|>> (format "Successfully cleaned target directory: "))) (def: #export (do! console fs profile) (-> (Console Promise) (file.System Promise) (Command Any)) - (do promise.monad + (do {! promise.monad} [#let [target (get@ #///.target profile)] - root (: (Promise (Try (Directory Promise))) - (\ fs directory target))] - (case root - (#try.Success root) - (do {! ///action.monad} - [_ (loop [root root] + ? (\ fs directory? target) + _ (let [! ///action.monad] + (if ? + (loop [root target] (do ! - [_ (..clean_files! root) - subs (: (Promise (Try (List (Directory Promise)))) - (\ root directories [])) - _ (monad.map ! recur subs)] - (\ root discard [])))] - (console.write_line (..success target) console)) - - (#try.Failure error) - (if (exception.match? file.cannot_find_directory error) - (console.write_line (..success target) console) - (\ promise.monad wrap (#try.Failure error)))))) + [_ (..clean_files! fs root) + _ (|> root + (\ fs sub_directories) + (\ ! map (monad.map ! recur)) + (\ ! join))] + (\ fs delete root))) + (\ ! wrap [])))] + (console.write_line (..success target) console))) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 36a129bd1..de4817ba8 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -39,8 +39,8 @@ (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution)) (do promise.monad [#let [dependencies (set.to_list (get@ #///.dependencies profile))] - [local_successes local_failures cache] (///dependency/resolution.all (list local) dependencies ///dependency/resolution.empty) - [remote_successes remote_failures resolution] (///dependency/resolution.all remotes dependencies cache)] + [local_successes local_failures cache] (///dependency/resolution.all console (list local) dependencies ///dependency/resolution.empty) + [remote_successes remote_failures resolution] (///dependency/resolution.all console remotes dependencies cache)] (do ///action.monad [cached (|> (dictionary.keys cache) (list\fold dictionary.remove resolution) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 4b6b96e3e..64830c4d2 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -21,7 +21,7 @@ ["." xml]]] [world [program (#+ Program)] - ["." file (#+ Path File)] + ["." file] ["." console (#+ Console)]]] [program [compositor @@ -49,13 +49,18 @@ (def: #export failure "Failure: No 'identity' defined for the project.") -(def: #export (do! console system repository profile) +(def: #export (do! console fs repository profile) (-> (Console Promise) (file.System Promise) (Repository Promise) (Command Any)) (case (get@ #/.identity profile) (#.Some identity) (do ///action.monad - [package (export.library system (set.to_list (get@ #/.sources profile))) - pom (\ promise.monad wrap (///pom.write profile)) + [package (|> profile + (get@ #/.sources) + set.to_list + (export.library fs)) + pom (|> profile + ///pom.write + (\ promise.monad wrap)) _ (///dependency/deployment.one repository [identity ///artifact/type.lux_library] (let [pom_data (|> pom diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index b8a728904..00427ee39 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -3,38 +3,33 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try)] + ["." try ("#\." functor)] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data - ["." text + [text ["%" format (#+ format)] [encoding ["." utf8]]] [format ["." xml]]] [world - ["." file (#+ Path File)] + ["." file] ["." console (#+ Console)]]] - ["." // #_ - ["#." clean] - ["/#" // #_ - [command (#+ Command)] - ["#." action (#+ Action)] - ["#." pom]]]) + ["." /// #_ + [command (#+ Command)] + ["#." action] + ["#." pom]]) (def: #export success (format "Successfully created POM file: " ///pom.file)) (def: #export (do! console fs profile) - (-> (Console Promise) (file.System Promise) (Command Path)) + (-> (Console Promise) (file.System Promise) (Command Any)) (do ///action.monad - [pom (promise\wrap (///pom.write profile)) - file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs ///pom.file)) - outcome (|> pom - (\ xml.codec encode) - (\ utf8.codec encode) - (\ file over_write)) - _ (console.write_line ..success console)] - (wrap ///pom.file))) + [content (|> (///pom.write profile) + (try\map (|>> (\ xml.codec encode) + (\ utf8.codec encode))) + promise\wrap) + _ (\ fs write content ///pom.file)] + (console.write_line ..success console))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 138ee31bf..326f2ac2d 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -32,6 +32,7 @@ ["n" nat] ["." i64]]] [world + [console (#+ Console)] [net (#+ URL) ["." uri] ["." http #_ @@ -157,8 +158,23 @@ ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))] ["Type" (%.text (get@ #//.type dependency))])) -(def: #export (any repositories dependency) - (-> (List (Repository Promise)) Dependency (Promise (Try Package))) +(template [<sigil> <name> <doing> <at>] + [(def: (<name> console repository artifact) + (-> (Console Promise) (Repository Promise) Artifact (Promise (Try Any))) + (\ console write (format "[" <sigil> "]" + " " <doing> + " " (///artifact.format artifact) + " " <at> + " " (%.text (\ repository description)) + text.new_line)))] + + ["?" announce_fetching "Fetching" "from"] + ["Y" announce_success "Found" "at"] + ["N" announce_failure "Missed" "from"] + ) + +(def: #export (any console repositories dependency) + (-> (Console Promise) (List (Repository Promise)) Dependency (Promise (Try Package))) (case repositories #.Nil (|> dependency @@ -166,17 +182,22 @@ (\ promise.monad wrap)) (#.Cons repository alternatives) - (do promise.monad - [outcome (..one repository dependency)] + (do {! promise.monad} + [_ (..announce_fetching console repository (get@ #//.artifact dependency)) + outcome (..one repository dependency)] (case outcome (#try.Success package) - (wrap outcome) + (do ! + [_ (..announce_success console repository (get@ #//.artifact dependency))] + (wrap outcome)) (#try.Failure error) - (any alternatives dependency))))) + (do ! + [_ (..announce_failure console repository (get@ #//.artifact dependency))] + (any console alternatives dependency)))))) -(def: #export (all repositories dependencies resolution) - (-> (List (Repository Promise)) (List Dependency) Resolution +(def: #export (all console repositories dependencies resolution) + (-> (Console Promise) (List (Repository Promise)) (List Dependency) Resolution (Promise [(List Dependency) (List Dependency) Resolution])) @@ -204,7 +225,7 @@ (wrap (#try.Success package)) #.None - (..any repositories head))] + (..any console repositories head))] (case ?package (#try.Success package) (do ! diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index 2e7dbbab6..606fefdeb 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -22,8 +22,7 @@ [world ["." file]]] ["." // #_ - ["#" profile (#+ Profile)] - ["#." action (#+ Action)] + [profile (#+ Profile)] ["#." project (#+ Project)] ["#." parser]]) @@ -48,11 +47,9 @@ (def: #export (read monad fs profile) (All [!] (-> (Monad !) (file.System !) Text (! (Try Profile)))) - (do (try.with monad) - [project_file (\ fs file //project.file) - project_file (\ project_file content [])] - (\ monad wrap - (|> project_file - (do> try.monad - [..parse_project] - [(//project.profile profile)]))))) + (|> //project.file + (\ fs read) + (\ monad map (|>> (do> try.monad + [] + [..parse_project] + [(//project.profile profile)]))))) diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux index 86981eb62..7fbe88cbc 100644 --- a/stdlib/source/program/aedifex/metadata.lux +++ b/stdlib/source/program/aedifex/metadata.lux @@ -1,7 +1,7 @@ (.module: [lux #* [data - [text + ["." text ["%" format (#+ format)]]] [world [file (#+ Path)] @@ -10,7 +10,7 @@ ["." // #_ ["#." artifact (#+ Artifact)]]) -(def: #export remote_file +(def: remote_file Path "maven-metadata.xml") @@ -29,6 +29,14 @@ / (get@ #//artifact.name artifact) / ..remote_file))) -(def: #export local_file +(def: local_file Path "maven-metadata-local.xml") + +(def: #export (local_uri remote_uri) + (-> URI URI) + (text.replace_once ..remote_file ..local_file remote_uri)) + +(def: #export (remote_uri local_uri) + (-> URI URI) + (text.replace_once ..local_file ..remote_file local_uri)) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 9210534cc..7150efbab 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -169,12 +169,9 @@ instant.equivalence )) -(def: #export (uri artifact) +(def: #export uri (-> Artifact URI) - (let [/ uri.separator - group (///artifact.directory / (get@ #///artifact.group artifact)) - name (get@ #///artifact.name artifact)] - (%.format group / name / //.remote_file))) + //.remote_project_uri) (def: epoch Instant diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index c8feaa3d9..6eec0c32c 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -117,15 +117,9 @@ ///artifact/versioning.equivalence )) -(def: #export (uri artifact) +(def: #export uri (-> Artifact URI) - (let [/ uri.separator - group (|> artifact - (get@ #///artifact.group) - (///artifact.directory /)) - name (get@ #///artifact.name artifact) - version (get@ #///artifact.version artifact)] - (%.format group / name / version / //.remote_file))) + //.remote_artifact_uri) (def: #export (read repository artifact) (-> (Repository Promise) Artifact (Promise (Try Metadata))) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index d966c7f82..05560c6c9 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -15,6 +15,8 @@ [uri (#+ URI)]]]]) (interface: #export (Repository !) + (: Text + description) (: (-> URI (! (Try Binary))) download) (: (-> URI Binary (! (Try Any))) @@ -23,6 +25,8 @@ (def: #export (async repository) (-> (Repository IO) (Repository Promise)) (implementation + (def: description + (\ repository description)) (def: (download uri) (promise.future (\ repository download uri))) @@ -31,6 +35,8 @@ )) (interface: #export (Mock s) + (: Text + the_description) (: (-> URI s (Try [s Binary])) on_download) (: (-> URI Binary s (Try s)) @@ -40,6 +46,8 @@ (All [s] (-> (Mock s) s (Repository Promise))) (let [state (stm.var init)] (implementation + (def: description + (\ mock the_description)) (def: (download uri) (stm.commit (do {! stm.monad} diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 8ceaf5ffc..b4ba0e22c 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -1,10 +1,9 @@ (.module: [lux #* - [ffi (#+ import:)] [abstract [monad (#+ do)]] [control - ["." try (#+ Try)] + ["." try] [concurrency ["." promise (#+ Promise)]]] [data @@ -12,7 +11,7 @@ ["%" format (#+ format)]]] [world [program (#+ Program)] - ["." file (#+ Path File)] + ["." file] [net ["." uri (#+ URI)]]]] ["." // @@ -21,40 +20,39 @@ ["#." metadata]]]) (def: (root /) - (-> Text Path) + (-> Text file.Path) (text.replace_all uri.separator / ///local.repository)) -(def: path - (-> Text URI Path) - (text.replace_all uri.separator)) +(def: (path /) + (-> Text (-> URI file.Path)) + (text.replace_all uri.separator /)) -(def: (file program system create? uri) - (-> (Program Promise) - (file.System Promise) - Bit - URI - (Promise (Try (File Promise)))) - (let [uri (text.replace_once ///metadata.remote_file ///metadata.local_file uri) - / (\ system separator) - absolute_path (format (..root /) / (..path / uri))] - (if create? - (do {! (try.with promise.monad)} - [_ (: (Promise (Try Path)) - (file.make_directories promise.monad system (file.parent system absolute_path)))] - (: (Promise (Try (File Promise))) - (file.get_file promise.monad system absolute_path))) - (: (Promise (Try (File Promise))) - (\ system file absolute_path))))) +(def: (absolute_path /) + (-> Text (-> URI file.Path)) + (|>> ///metadata.local_uri + (..path /) + (format (..root /) /))) -(implementation: #export (repository program system) +(implementation: #export (repository program fs) (-> (Program Promise) (file.System Promise) (//.Repository Promise)) - (def: (download uri) - (do {! (try.with promise.monad)} - [file (..file program system false uri)] - (\ file content []))) + (def: description + (..root (\ fs separator))) + (def: download + (|>> (..absolute_path (\ fs separator)) + (\ fs read))) (def: (upload uri content) - (do {! (try.with promise.monad)} - [file (..file program system true uri)] - (\ file over_write content)))) + (do {! promise.monad} + [#let [absolute_path (..absolute_path (\ fs separator) uri)] + ? (\ fs file? absolute_path) + _ (if ? + (wrap []) + (case (file.parent fs absolute_path) + (#.Some parent) + (file.make_directories promise.monad fs parent) + + _ + (let [! (try.with promise.monad)] + (\ ! wrap []))))] + (\ fs write content absolute_path)))) diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux index 50115f123..7feaa9710 100644 --- a/stdlib/source/program/aedifex/repository/remote.lux +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -56,6 +56,8 @@ (implementation: #export (repository http identity address) (All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO))) + (def: description + address) (def: (download uri) (do {! (try.with io.monad)} [[status message] (: (IO (Try (@http.Response IO))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index f443301db..8b577ec09 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -2,7 +2,6 @@ [lux (#- Module) [type (#+ :share)] ["." debug] - ["@" target] [abstract [monad (#+ Monad do)]] [control @@ -21,7 +20,7 @@ [time ["." instant]] ["." world #_ - ["." file (#+ File Path)] + ["." file] ["#/." program] ## ["." console] ] @@ -83,43 +82,14 @@ (format "Duration: ")))]] (wrap output))) -(def: (package! monad file_system [packager package] static archive context) - (All [!] (-> (Monad !) (file.System !) [Packager Path] Static Archive Context (! (Try Any)))) - (for {@.old - (case (packager archive context) - (#try.Success content) - (do (try.with monad) - [package (:share [!] - (Monad !) - monad - - (! (Try (File !))) - (:assume (file.get_file monad file_system package)))] - (\ (:share [!] - (Monad !) - monad - - (File !) - (:assume package)) - over_write - content)) - - (#try.Failure error) - (\ monad wrap (#try.Failure error)))} - ## TODO: Fix whatever type_checker bug is forcing me into this compromise... - (:assume - (: (Promise (Try Any)) - (let [monad (:coerce (Monad Promise) monad) - file_system (:coerce (file.System Promise) file_system)] - (case (packager archive context) - (#try.Success content) - (do (try.with monad) - [package (: (Promise (Try (File Promise))) - (file.get_file monad file_system package))] - (\ (: (File Promise) package) over_write content)) - - (#try.Failure error) - (\ monad wrap (#try.Failure error)))))))) +(def: (package! monad fs [packager package] static archive context) + (All [!] (-> (Monad !) (file.System !) [Packager file.Path] Static Archive Context (! (Try Any)))) + (case (packager archive context) + (#try.Success content) + (\ fs write content package) + + (#try.Failure error) + (\ monad wrap (#try.Failure error)))) (with_expansions [<parameters> (as_is anchor expression artifact)] (def: #export (compiler static @@ -137,7 +107,7 @@ [Type Type Type] Extender Service - [Packager Path] + [Packager file.Path] (Promise Any))) (do {! promise.monad} [platform (promise.future platform)] diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 238034534..24ba3492c 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -38,16 +38,16 @@ {#tar.user commons #tar.group commons})) -(def: #export (library system sources) +(def: #export (library fs sources) (-> (file.System Promise) (List Source) (Promise (Try tar.Tar))) (do (try.with promise.monad) - [files (io.enumerate system sources)] + [files (io.enumerate fs sources)] (|> (dictionary.entries files) (monad.map try.monad (function (_ [path source_code]) (do try.monad [path (|> path - (text.replace_all (\ system separator) .module_separator) + (text.replace_all (\ fs separator) .module_separator) tar.path) source_code (tar.content source_code)] (wrap (#tar.Normal [path @@ -61,13 +61,11 @@ (\ try.monad map row.from_list) (\ promise.monad wrap)))) -(def: #export (export system [sources target]) +(def: #export (export fs [sources target]) (-> (file.System Promise) Export (Promise (Try Any))) - (do (try.with promise.monad) - [tar (..library system sources) - package (: (Promise (Try (file.File Promise))) - (file.get_file promise.monad system - (format target (\ system separator) ..file)))] - (|> tar - (binary.run tar.writer) - (\ package over_write)))) + (do {! (try.with promise.monad)} + [tar (\ ! map (binary.run tar.writer) + (..library fs sources))] + (|> ..file + (format target (\ fs separator)) + (\ fs write tar)))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 19a2d7607..f91ad03e7 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -8,7 +8,7 @@ [concurrency ["." promise (#+ Promise) ("#\." monad)]] ["<>" parser - ["<b>" binary]]] + ["<.>" binary]]] [data [binary (#+ Binary)] ["." text @@ -24,7 +24,7 @@ [archive [descriptor (#+ Module)]]]]] [world - ["." file (#+ Path File)]]] + ["." file]]] [// [cli (#+ Library)]]) @@ -39,32 +39,32 @@ ["Library" (%.text library)])) (type: #export Import - (Dictionary Path Binary)) + (Dictionary file.Path Binary)) (def: (import_library system library import) (-> (file.System Promise) Library Import (Action Import)) - (do (try.with promise.monad) - [file (: (Action (File Promise)) - (\ system file library)) - binary (\ file content [])] - (promise\wrap - (do {! try.monad} - [tar (<b>.run tar.parser binary)] - (monad.fold ! (function (_ entry import) - (case entry - (#tar.Normal [path instant mode ownership content]) - (let [path (tar.from_path path)] - (case (dictionary.try_put path (tar.data content) import) - (#try.Success import) - (wrap import) - - (#try.Failure error) - (exception.throw ..duplicate [library path]))) - - _ - (exception.throw ..useless_tar_entry []))) - import - (row.to_list tar)))))) + (let [! promise.monad] + (|> library + (\ system read) + (\ ! map (let [! try.monad] + (|>> (\ ! map (<binary>.run tar.parser)) + (\ ! join) + (\ ! map (|>> row.to_list + (monad.fold ! (function (_ entry import) + (case entry + (#tar.Normal [path instant mode ownership content]) + (let [path (tar.from_path path)] + (case (dictionary.try_put path (tar.data content) import) + (#try.Failure error) + (exception.throw ..duplicate [library path]) + + import' + import')) + + _ + (exception.throw ..useless_tar_entry []))) + import))) + (\ ! join))))))) (def: #export (import system libraries) (-> (file.System Promise) (List Library) (Action Import)) diff --git a/stdlib/source/spec/lux/world/file.lux b/stdlib/source/spec/lux/world/file.lux new file mode 100644 index 000000000..8a13279ad --- /dev/null +++ b/stdlib/source/spec/lux/world/file.lux @@ -0,0 +1,351 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate]] + [control + [pipe (#+ case>)] + [io (#+ IO)] + ["." try ("#\." functor)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." maybe ("#\." functor)] + ["." text ("#\." equivalence) + ["%" format (#+ format)] + [encoding + ["." utf8 ("#\." codec)]]] + ["." binary (#+ Binary) ("#\." equivalence monoid) + {[0 #test] + ["$#" /]}] + [collection + ["." list]]] + [math + ["." random] + [number + ["n" nat]]] + [time + ["." instant (#+ Instant) ("#\." equivalence)]]] + {1 + ["." /]}) + +(def: (for_path fs) + (-> (IO (/.System Promise)) Test) + (<| (_.for [/.Path]) + (do {! random.monad} + [parent (random.ascii/numeric 2) + child (random.ascii/numeric 2)]) + wrap + (do promise.monad + [fs (promise.future fs)] + ($_ _.and' + (_.cover' [/.un_nest] + (and (|> (/.un_nest fs parent) + (case> (#.Some _) + false + + #.None + true)) + (|> (/.un_nest fs child) + (case> (#.Some _) + false + + #.None + true)))) + (_.cover' [/.nest] + (|> (/.nest fs parent child) + (/.un_nest fs) + (case> (#.Some [parent' child']) + (and (text\= parent parent') + (text\= child child')) + + #.None + false))) + (_.cover' [/.parent] + (|> (/.nest fs parent child) + (/.parent fs) + (maybe\map (text\= parent)) + (maybe.default false))) + (_.cover' [/.name] + (|> (/.nest fs parent child) + (/.name fs) + (text\= child))) + )))) + +(def: (directory?&make_directory fs parent) + (-> (/.System Promise) /.Path (Promise Bit)) + (do promise.monad + [directory_pre! (\ fs directory? parent) + made? (\ fs make_directory parent) + directory_post! (\ fs directory? parent)] + (wrap (and (not directory_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + directory_post!)))) + +(def: (file?&write fs content path) + (-> (/.System Promise) Binary /.Path (Promise Bit)) + (do promise.monad + [file_pre! (\ fs file? path) + made? (\ fs write content path) + file_post! (\ fs file? path)] + (wrap (and (not file_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + file_post!)))) + +(def: (file_size&read&append fs expected_file_size content appendix path) + (-> (/.System Promise) Nat Binary Binary /.Path (Promise Bit)) + (do promise.monad + [pre_file_size (\ fs file_size path) + pre_content (\ fs read path) + appended? (\ fs append appendix path) + post_file_size (\ fs file_size path) + post_content (\ fs read path)] + (wrap (<| (try.default false) + (do {! try.monad} + [pre_file_size! + (\ ! map (n.= expected_file_size) pre_file_size) + + pre_content! + (\ ! map (binary\= content) pre_content) + + _ appended? + + post_file_size! + (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) + + post_content! + (\ ! map (binary\= (binary\compose content appendix)) post_content)] + (wrap (and pre_file_size! + pre_content! + post_file_size! + post_content!))))))) + +(def: (modified?&last_modified fs expected_time path) + (-> (/.System Promise) Instant /.Path (Promise Bit)) + (do promise.monad + [modified? (\ fs modify expected_time path) + last_modified (\ fs last_modified path)] + (wrap (<| (try.default false) + (do {! try.monad} + [_ modified?] + (\ ! map (instant\= expected_time) last_modified)))))) + +(def: (directory_files&sub_directories fs parent sub_dir child) + (-> (/.System Promise) /.Path /.Path /.Path (Promise Bit)) + (let [sub_dir (/.nest fs parent sub_dir) + child (/.nest fs parent child)] + (do promise.monad + [made_sub? (\ fs make_directory sub_dir) + directory_files (\ fs directory_files parent) + sub_directories (\ fs sub_directories parent) + #let [(^open "list\.") (list.equivalence text.equivalence)]] + (wrap (<| (try.default false) + (do try.monad + [_ made_sub?] + (wrap (and (|> directory_files + (try\map (list\= (list child))) + (try.default false)) + (|> sub_directories + (try\map (list\= (list sub_dir))) + (try.default false)))))))))) + +(def: (move&delete fs parent child alternate_child) + (-> (/.System Promise) /.Path Text Text (Promise Bit)) + (let [origin (/.nest fs parent child) + destination (/.nest fs parent alternate_child)] + (do {! promise.monad} + [moved? (\ fs move destination origin) + lost? (|> origin + (\ fs file?) + (\ ! map not)) + found? (\ fs file? destination) + deleted? (\ fs delete destination)] + (wrap (<| (try.default false) + (do try.monad + [_ moved? + _ deleted?] + (wrap (and lost? + found?)))))))) + +(def: (for_system fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [parent (random.ascii/numeric 2) + child (random.ascii/numeric 2) + sub_dir (random.filter (|>> (text\= child) not) + (random.ascii/numeric 2)) + alternate_child (random.filter (predicate.intersect + (|>> (text\= child) not) + (|>> (text\= sub_dir) not)) + (random.ascii/numeric 2)) + expected_file_size (\ ! map (|>> (n.% 10) inc) random.nat) + content ($binary.random expected_file_size) + appendix ($binary.random expected_file_size) + expected_time random.instant]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + #let [path (/.nest fs parent child)] + + directory?&make_directory + (..directory?&make_directory fs parent) + + file?&write + (..file?&write fs content path) + + file_size&read&append + (..file_size&read&append fs expected_file_size content appendix path) + + modified?&last_modified + (..modified?&last_modified fs expected_time path) + + can_execute? + (|> path + (\ fs can_execute?) + (\ ! map (|>> (try.default true) not))) + + directory_files&sub_directories + (..directory_files&sub_directories fs parent sub_dir child) + + move&delete + (..move&delete fs parent child alternate_child)]) + (_.cover' [/.System] + (and directory?&make_directory + file?&write + file_size&read&append + modified?&last_modified + can_execute? + directory_files&sub_directories + move&delete)))) + +(def: (make_directories&cannot_make_directory fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [dir/0 (random.ascii/numeric 2) + dir/1 (random.ascii/numeric 2) + dir/2 (random.ascii/numeric 2)]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + #let [dir/1 (/.nest fs dir/0 dir/1) + dir/2 (/.nest fs dir/1 dir/2)] + pre_dir/0 (\ fs directory? dir/0) + pre_dir/1 (\ fs directory? dir/1) + pre_dir/2 (\ fs directory? dir/2) + made? (/.make_directories ! fs dir/2) + post_dir/0 (\ fs directory? dir/0) + post_dir/1 (\ fs directory? dir/1) + post_dir/2 (\ fs directory? dir/2) + + cannot_make_directory!/0 (/.make_directories ! fs "") + cannot_make_directory!/1 (/.make_directories ! fs (\ fs separator))]) + ($_ _.and' + (_.cover' [/.make_directories] + (and (not pre_dir/0) + (not pre_dir/1) + (not pre_dir/2) + (case made? + (#try.Success _) true + (#try.Failure _) false) + post_dir/0 + post_dir/1 + post_dir/2)) + (_.cover' [/.cannot_make_directory] + (and (case cannot_make_directory!/0 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_directory error)) + (case cannot_make_directory!/1 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_directory error)))) + ))) + +(def: (make_file&cannot_make_file fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [file/0 (random.ascii/numeric 3)]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + make_file!/0 (/.make_file ! fs (utf8\encode file/0) file/0) + make_file!/1 (/.make_file ! fs (utf8\encode file/0) file/0)]) + ($_ _.and' + (_.cover' [/.make_file] + (case make_file!/0 + (#try.Success _) true + (#try.Failure error) false)) + (_.cover' [/.cannot_make_file] + (case make_file!/1 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_file error))) + ))) + +(def: (for_utilities fs) + (-> (IO (/.System Promise)) Test) + ($_ _.and + (..make_directories&cannot_make_directory fs) + (..make_file&cannot_make_file fs) + )) + +(def: (exists? fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [file (random.ascii/numeric 2) + dir (random.filter (|>> (text\= file) not) + (random.ascii/numeric 2))]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + + pre_file/0 (\ fs file? file) + pre_file/1 (/.exists? ! fs file) + pre_dir/0 (\ fs directory? dir) + pre_dir/1 (/.exists? ! fs dir) + + made_file? (/.make_file ! fs (utf8\encode file) file) + made_dir? (\ fs make_directory dir) + + post_file/0 (\ fs file? file) + post_file/1 (/.exists? ! fs file) + post_dir/0 (\ fs directory? dir) + post_dir/1 (/.exists? ! fs dir)]) + (_.cover' [/.exists?] + (and (not pre_file/0) + (not pre_file/1) + (not pre_dir/0) + (not pre_dir/1) + + (case made_file? + (#try.Success _) true + (#try.Failure _) false) + (case made_dir? + (#try.Success _) true + (#try.Failure _) false) + + post_file/0 + post_file/1 + post_dir/0 + post_dir/1)))) + +(def: #export (spec fs) + (-> (IO (/.System Promise)) Test) + ($_ _.and + (..for_path fs) + (..for_utilities fs) + (..for_system fs) + (..exists? fs) + )) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 09ffcd3d8..b6f54f8f4 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -3,7 +3,7 @@ [program (#+ program:)] ["_" test (#+ Test)] [control - [io (#+ io)]]] + ["." io]]] ["." / #_ ["#." artifact] ["#." cli] @@ -54,7 +54,7 @@ )) (program: args - (<| io + (<| io.io _.run! (_.times 100) ..test)) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 0808c7d21..effc80871 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -4,51 +4,47 @@ [abstract [monad (#+ do)]] [control + [pipe (#+ case>)] ["." try] [parser - ["." environment (#+ Environment)]] + ["." environment]] [concurrency ["." atom (#+ Atom)] ["." promise (#+ Promise)]]] [data + ["." binary] ["." text ["%" format (#+ format)] [encoding ["." utf8]]] [collection - ["." dictionary] - ["." set] - ["." list ("#\." functor)]]] + ["." set]]] [math - ["." random (#+ Random)] + ["." random] [number ["n" nat]]] + [time + ["." instant]] [world [console (#+ Console)] ["." shell (#+ Shell)] ["." program (#+ Program)] - ["." file (#+ Path File) + ["." file ["." watch]]]] ["." // #_ - ["@." version] - ["@." build] - ["$/#" // #_ - ["#." package]]] + ["$." version] + ["$." build]] {#program ["." / - ["/#" // #_ - ["#." build] - ["/#" // #_ - [command (#+ Command)] - ["#" profile (#+ Profile)] - ["#." action] - ["#." artifact - ["#/." type]] - ["#." dependency - ["#/." resolution (#+ Resolution)]]]]]}) + ["//#" /// #_ + [command (#+ Command)] + ["#" profile (#+ Profile)] + ["#." action] + [dependency + [resolution (#+ Resolution)]]]]}) -(def: (command expected_runs end_signal dummy_file) - (-> Nat Text (File Promise) +(def: (command expected_runs end_signal fs dummy_file) + (-> Nat Text (file.System Promise) file.Path [(Atom Nat) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom Nat) @@ -60,18 +56,18 @@ (if (n.= expected_runs actual_runs) (wrap (#try.Failure end_signal)) (do (try.with !) - [_ (\ dummy_file over_write (\ utf8.codec encode (%.nat actual_runs)))] - (do ! - [_ (promise.future (atom.write actual_runs @runs))] - (wrap (#try.Success [])))))))])) + [_ (\ fs write (\ utf8.codec encode (%.nat actual_runs)) dummy_file)] + (\ fs modify + (|> actual_runs .int instant.from_millis) + dummy_file)))))])) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [#let [/ (\ file.default separator) + [end_signal (random.ascii/alpha 5) + #let [/ (\ file.default separator) [fs watcher] (watch.mock /)] - end_signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) @@ -93,30 +89,33 @@ expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) dummy_path (\ ! map (|>> (format source /)) (random.ascii/alpha 5)) - resolution @build.resolution] + resolution $build.resolution] ($_ _.and (wrap (do promise.monad [verdict (do ///action.monad - [_ (\ fs create_directory source) - dummy_file (\ fs create_file dummy_path) - #let [[@runs command] (..command expected_runs end_signal dummy_file)] + [_ (\ fs make_directory source) + _ (\ fs write (binary.create 0) dummy_path) + #let [[@runs command] (..command expected_runs end_signal fs dummy_path)] _ (\ watcher poll [])] - (do promise.monad - [outcome ((/.do! 1 watcher command) - (@version.echo "") - (program.async (program.mock environment.empty home working_directory)) - fs - (shell.async (@build.good_shell [])) - resolution - profile) - actual_runs (promise.future (atom.read @runs))] - (wrap (#try.Success (and (n.= expected_runs actual_runs) - (case outcome - (#try.Failure error) - (is? end_signal error) + (do {! promise.monad} + [no_dangling_process! (|> profile + ((/.do! 1 watcher command) + ($version.echo "") + (program.async (program.mock environment.empty home working_directory)) + fs + (shell.async ($build.good_shell [])) + resolution) + (\ ! map (|>> (case> (#try.Failure error) + (is? end_signal error) - (#try.Success _) - false))))))] + (#try.Success _) + false)))) + correct_number_of_runs! (|> @runs + atom.read + promise.future + (\ ! map (n.= expected_runs)))] + (wrap (#try.Success (and correct_number_of_runs! + no_dangling_process!)))))] (_.cover' [/.do!] (try.default false verdict)))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 18997e02e..e23e99b96 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -20,7 +20,7 @@ [number ["n" nat]]] [world - ["." file (#+ Path File)]]] + ["." file (#+ Path)]]] [// ["@." version] [// @@ -28,7 +28,7 @@ [// [lux [data - ["_." binary]]]]]] + ["$." binary]]]]]] {#program ["." / ["//#" /// #_ @@ -44,32 +44,29 @@ (do {! random.monad} [count (\ ! map (n.% 10) random.nat) names (random.set text.hash count ..node_name) - contents (random.list count (_binary.random 100))] + contents (random.list count ($binary.random 100))] (wrap (list.zip/2 (list\map (|>> (format prefix)) (set.to_list names)) contents)))) (def: (create_file! fs [path content]) (-> (file.System Promise) [Path Binary] (Promise (Try Any))) - (do {! (try.with promise.monad)} - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs path))] - (\ file over_write content))) + (\ fs write content path)) (def: (create_directory! fs path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any))) (do {! (try.with promise.monad)} - [_ (: (Promise (Try Path)) + [_ (: (Promise (Try Any)) (file.make_directories promise.monad fs path)) _ (monad.map ! (..create_file! fs) files)] (wrap []))) (def: (directory_exists? fs) (-> (file.System Promise) Path (Promise (Try Bit))) - (|>> (file.directory_exists? promise.monad fs) (try.lift promise.monad))) + (|>> (\ fs directory?) (try.lift promise.monad))) (def: (file_exists? fs) (-> (file.System Promise) Path (Promise (Try Bit))) - (|>> (file.file_exists? promise.monad fs) (try.lift promise.monad))) + (|>> (\ fs file?) (try.lift promise.monad))) (def: (assets_exist? fs directory_path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index fd4395935..a40d8e394 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -2,17 +2,16 @@ [lux #* ["_" test (#+ Test)] [abstract - ["." monad (#+ do)]] + [monad (#+ do)]] [control - ["." try (#+ Try) ("#\." functor)] - ["." exception] + ["." try (#+ Try)] [concurrency ["." promise (#+ Promise)]] [parser - ["." environment (#+ Environment)]]] + ["." environment]]] [data ["." maybe] - ["." binary] + ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)] [encoding @@ -22,61 +21,40 @@ ["." tar] ["." xml]] [collection - ["." set (#+ Set)] - ["." dictionary (#+ Dictionary)]]] + ["." set]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ Path File)] + ["." file] ["." program (#+ Program)]]] [program [compositor ["." export]]] [// - ["@." version] + ["$." install] + ["$." version] [// - ["@." profile] - ["@." repository]]] + ["$." profile] + ["$." repository]]] {#program ["." / - ["/#" // #_ - ["#." clean] - ["/#" // #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." hash] - ["#." repository (#+ Repository) - [identity (#+ Identity)] - ["#/." remote]] - ["#." artifact (#+ Artifact) - ["#/." extension]]]]]}) - -(def: (make_sources! fs sources) - (-> (file.System Promise) (Set Path) (Promise (Try Any))) - (loop [sources (set.to_list sources)] - (case sources - #.Nil - (|> [] - (\ try.monad wrap) - (\ promise.monad wrap)) - - (#.Cons head tail) - (do (try.with promise.monad) - [_ (: (Promise (Try Path)) - (file.make_directories promise.monad fs head)) - _ (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs (format head (\ fs separator) head ".lux")))] - (recur tail))))) + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." hash] + ["#." repository (#+ Repository) + ["#/." remote]] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]}) (def: (execute! program repository fs artifact profile) (-> (Program Promise) (Repository Promise) (file.System Promise) Artifact ///.Profile (Promise (Try Text))) (do ///action.monad - [#let [console (@version.echo "")] - _ (..make_sources! fs (get@ #///.sources profile)) + [#let [console ($version.echo "")] + _ ($install.make_sources! fs (get@ #///.sources profile)) _ (/.do! console repository fs artifact profile)] (\ console read_line []))) @@ -90,12 +68,12 @@ [artifact (get@ #///.identity profile) expected_pom (try.to_maybe (///pom.write profile))] (wrap [artifact expected_pom profile]))) - @profile.random) + $profile.random) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) - #let [repository (///repository.mock @repository.mock - @repository.empty) + #let [repository (///repository.mock $repository.mock + $repository.empty) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] (wrap (do {! promise.monad} @@ -124,14 +102,12 @@ (text\= /.success logging) deployed_library! - (\ binary.equivalence = - expected_library - actual_library) + (binary\= expected_library + actual_library) deployed_pom! - (\ binary.equivalence = - (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) - actual_pom) + (binary\= (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) + actual_pom) deployed_sha-1! (\ ///hash.equivalence = diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index bb52b3cca..5800bca6d 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -9,63 +9,52 @@ [concurrency ["." promise (#+ Promise)]] [parser - ["." environment (#+ Environment)]]] + ["." environment]]] [data - ["." maybe] ["." binary] ["." text ("#\." equivalence) ["%" format (#+ format)]] - [format - ["." xml]] [collection ["." set (#+ Set)]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ Path File)] - ["." program (#+ Program)] - [net - ["." uri]]]] + ["." file] + ["." program (#+ Program)]]] [// - ["@." version] + ["$." version] [// - ["@." profile] - ["@." artifact]]] + ["$." profile] + ["$." artifact]]] {#program ["." / ["/#" // #_ - ["#." clean] ["/#" // #_ ["#" profile] - ["#." action] - ["#." pom] + ["#." action (#+ Action)] ["#." local] ["#." artifact ["#/." extension]] ["#." repository #_ ["#/." local]]]]]}) -(def: (make_sources! fs sources) - (-> (file.System Promise) (Set Path) (Promise (Try Any))) - (loop [sources (set.to_list sources)] - (case sources - #.Nil - (|> [] - (\ try.monad wrap) - (\ promise.monad wrap)) - - (#.Cons head tail) - (do (try.with promise.monad) - [_ (: (Promise (Try Path)) - (file.make_directories promise.monad fs head)) - _ (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs (format head (\ fs separator) head ".lux")))] - (recur tail))))) +(def: #export (make_sources! fs sources) + (-> (file.System Promise) (Set file.Path) (Action (List Any))) + (let [/ (\ fs separator) + ! ///action.monad] + (|> sources + set.to_list + (monad.map ! (function (_ head) + (do ! + [_ (: (Promise (Try Any)) + (file.make_directories promise.monad fs head))] + (: (Promise (Try Any)) + (file.make_file promise.monad fs (binary.create 0) (format head / head ".lux"))))))))) (def: (execute! program fs sample) (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text))) (do ///action.monad - [#let [console (@version.echo "")] + [#let [console ($version.echo "")] _ (..make_sources! fs (get@ #///.sources sample)) _ (/.do! console fs (///repository/local.repository program fs) sample)] (\ console read_line []))) @@ -74,29 +63,28 @@ Test (<| (_.covering /._) (do {! random.monad} - [identity @artifact.random + [identity $artifact.random sample (\ ! map (set@ #///.identity (#.Some identity)) - @profile.random) + $profile.random) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5)] ($_ _.and (wrap (do {! promise.monad} [#let [fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working_directory))] - verdict (do ///action.monad - [logging (..execute! program fs sample) - #let [/ uri.separator - artifact_path (///local.uri (get@ #///artifact.version identity) identity) - library_path (format artifact_path ///artifact/extension.lux_library) - pom_path (format artifact_path ///artifact/extension.pom)] + program (program.async (program.mock environment.empty home working_directory)) - #let [succeeded! (text\= /.success logging)] - library_exists! (\ promise.monad map - exception.return - (file.file_exists? promise.monad fs library_path)) - pom_exists! (\ promise.monad map - exception.return - (file.file_exists? promise.monad fs pom_path))] + artifact_path (///local.uri (get@ #///artifact.version identity) identity) + library_path (format artifact_path ///artifact/extension.lux_library) + pom_path (format artifact_path ///artifact/extension.pom)] + verdict (do {! ///action.monad} + [succeeded! (\ ! map (text\= /.success) + (..execute! program fs sample)) + library_exists! (|> library_path + (\ fs file?) + (\ promise.monad map exception.return)) + pom_exists! (|> pom_path + (\ fs file?) + (\ promise.monad map exception.return))] (wrap (and succeeded! library_exists! pom_exists!)))] diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 0338bf7c4..2ac23ec7a 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -4,32 +4,30 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try) ("#\." functor)] + ["." try ("#\." functor)] [concurrency - ["." promise (#+ Promise)]]] + ["." promise]]] [data - ["." binary] + ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) [encoding ["." utf8]]] [format ["." xml]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ File)]]] + ["." file]]] [// ["@." version] [// ["@." profile]]] {#program ["." / - ["/#" // #_ - ["#." clean] - ["/#" // #_ - ["#" profile] - ["#." action] - ["#." pom]]]]}) + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom]]]}) (def: #export test Test @@ -41,27 +39,22 @@ [#let [console (@version.echo "")] outcome (/.do! console fs sample)] (case outcome - (#try.Success path) + (#try.Success _) (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode))) + (try\map (|>> (\ xml.codec encode) + (\ utf8.codec encode))) (\ ! wrap)) - file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs path)) - actual (\ file content []) + actual (\ fs read ///pom.file) logging! (\ ///action.monad map (text\= /.success) (\ console read_line [])) - #let [expected_path! - (text\= ///pom.file path) - - expected_content! - (\ binary.equivalence = expected actual)]] + #let [expected_content! + (binary\= expected actual)]] (wrap (and logging! - expected_path! expected_content!)))] (_.cover' [/.do! /.success] (try.default false verdict))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 7dcf46d3a..42116844f 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -30,7 +30,9 @@ ["$." /// #_ ["#." package] ["#." repository] - ["#." artifact]] + ["#." artifact] + [command + ["#." version]]] {#program ["." / ["//#" /// #_ @@ -88,6 +90,8 @@ (-> Artifact Package (Mock Any)) (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] (implementation + (def: the_description + "[1]") (def: (on_download uri state) (if (text.contains? expected uri) (let [library (: Binary @@ -127,6 +131,8 @@ (def: (bad_sha-1 expected_artifact expected_package dummy_package) (-> Artifact Package Package (Mock Any)) (implementation + (def: the_description + "[~SHA-1]") (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) @@ -178,6 +184,8 @@ (def: (bad_md5 expected_artifact expected_package dummy_package) (-> Artifact Package Package (Mock Any)) (implementation + (def: the_description + "[~MD5]") (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) @@ -289,7 +297,9 @@ ($_ _.and (wrap (do promise.monad - [actual_package (/.any (list (///repository.mock bad_sha-1 []) + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) (///repository.mock bad_md5 []) (///repository.mock good [])) {#///dependency.artifact expected_artifact @@ -305,7 +315,9 @@ false)))) (wrap (do promise.monad - [actual_package (/.any (list (///repository.mock bad_sha-1 []) + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) (///repository.mock bad_md5 [])) {#///dependency.artifact expected_artifact #///dependency.type ///artifact/type.lux_library})] @@ -390,7 +402,9 @@ ($_ _.and (wrap (do promise.monad - [[successes failures resolution] (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) + [#let [console ($///version.echo "")] + [successes failures resolution] (/.all console + (list (///repository.mock (..single dependee_artifact dependee_package) []) (///repository.mock (..single depender_artifact depender_package) []) (///repository.mock (..single ignored_artifact ignored_package) [])) (list depender) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index 0241b27a9..c379a8b0c 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -8,19 +8,18 @@ [concurrency ["." promise (#+ Promise)]]] [data - ["." binary] - ["." text - ["%" format (#+ format)] + [text + ["%" format] [encoding ["." utf8]]] [collection ["." set (#+ Set)]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ File)]]] + ["." file]]] [// - ["@." profile]] + ["$." profile]] {#program ["." / ["/#" // #_ @@ -45,18 +44,16 @@ Test (<| (_.covering /._) (do {! random.monad} - [expected (\ ! map (set@ #//.parents (list)) @profile.random) + [expected (\ ! map (set@ #//.parents (list)) $profile.random) #let [fs (: (file.System Promise) (file.mock (\ file.default separator)))]] (wrap (do promise.monad [verdict (do //action.monad - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs //project.file)) - _ (|> expected - //format.profile - %.code - (\ utf8.codec encode) - (\ file over_write)) + [#let [profile (|> expected + //format.profile + %.code + (\ utf8.codec encode))] + _ (\ fs write profile //project.file) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] (wrap (\ //.equivalence = diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 33104330b..224ce4d80 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -4,14 +4,14 @@ [abstract [monad (#+ do)]] [data - ["." text]] + ["." text ("#\." equivalence)]] [math ["." random]]] ["." / #_ ["#." artifact] ["#." snapshot] [// - ["@." artifact]]] + ["$." artifact]]] {#program ["." /]}) @@ -19,6 +19,32 @@ Test (<| (_.covering /._) ($_ _.and + (do random.monad + [sample $artifact.random] + ($_ _.and + (_.cover [/.remote_artifact_uri /.remote_project_uri] + (not (text\= (/.remote_artifact_uri sample) + (/.remote_project_uri sample)))) + (_.cover [/.local_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (not (text\= remote_artifact_uri (/.local_uri remote_artifact_uri))) + (not (text\= remote_project_uri (/.local_uri remote_project_uri)))))) + (_.cover [/.remote_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (text\= remote_artifact_uri (/.remote_uri remote_artifact_uri)) + (text\= remote_project_uri (/.remote_uri remote_project_uri)) + (|> remote_artifact_uri + /.local_uri + /.remote_uri + (text\= remote_artifact_uri)) + (|> remote_project_uri + /.local_uri + /.remote_uri + (text\= remote_project_uri))))) + )) + /artifact.test /snapshot.test ))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 98d869b5b..d16734a60 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -66,6 +66,8 @@ (implementation: #export mock (/.Mock Store) + (def: the_description + "@") (def: (on_download uri state) (case (dictionary.get uri state) (#.Some content) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index bc7231470..beebb2844 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -11,7 +11,7 @@ [monad (#+ do)] [predicate (#+ Predicate)]] [control - ["." io (#+ io)] + ["." io] [concurrency ["." atom (#+ Atom)]]] [data @@ -260,21 +260,14 @@ ))) (program: args - (let [shift (for {@.jvm 1 - @.old 1 - @.js 2 - @.python 6} - 0) - time_out (|> 1 - (i64.left_shift shift) - (n.* 1,000)) - times (: (-> Test Test) - (for {@.js (_.times 10) - @.python (_.times 1) - @.lua (_.times 1) - @.ruby (_.times 1)} - (_.times' (#.Some time_out) 100)))] - (<| io + (let [times (for {@.old 100 + @.jvm 100 + @.js 10 + @.python 1 + @.lua 1 + @.ruby 1} + 100)] + (<| io.io _.run! - times + (_.times times) ..test))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 8a0c416be..4b9f8655a 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -1,206 +1,27 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [control - ["." io (#+ IO)] - ["." try (#+ Try)] - [concurrency - ["." promise]]] - [data - ["." binary (#+ Binary)] - ["." text] - [collection - ["." list]]] + ["." io]] [math - ["." random (#+ Random) ("#\." monad)] - [number - ["n" nat] - ["i" int]]] - [time - ["." instant] - ["." duration]]] + ["." random]]] ["." / #_ ["#." watch]] {1 - ["." / (#+ Path File)]} - [/// - [data - ["_." binary]]]) - -(def: truncate_millis - (let [millis +1,000] - (|>> (i./ millis) (i.* millis)))) - -## (def: (creation_and_deletion number) -## (-> Nat Test) -## (random\wrap -## (do promise.monad -## [#let [path (format "temp_file_" (%.nat number))] -## result (promise.future -## (do (try.with io.monad) -## [#let [check_existence! (: (IO (Try Bit)) -## (try.lift io.monad (/.exists? io.monad /.default path)))] -## pre! check_existence! -## file (!.use (\ /.default create_file) path) -## post! check_existence! -## _ (!.use (\ file delete) []) -## remains? check_existence!] -## (wrap (and (not pre!) -## post! -## (not remains?)))))] -## (_.assert "Can create/delete files." -## (try.default #0 result))))) - -## (def: (read_and_write number data) -## (-> Nat Binary Test) -## (random\wrap -## (do promise.monad -## [#let [path (format "temp_file_" (%.nat number))] -## result (promise.future -## (do (try.with io.monad) -## [file (!.use (\ /.default create_file) path) -## _ (!.use (\ file over_write) data) -## content (!.use (\ file content) []) -## _ (!.use (\ file delete) [])] -## (wrap (\ binary.equivalence = data content))))] -## (_.assert "Can write/read files." -## (try.default #0 result))))) + ["." /]} + {[1 #spec] + ["$." /]}) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [file_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) - dataL (_binary.random file_size) - dataR (_binary.random file_size) - new_modified (|> random.int (\ ! map (|>> i.abs - (i.% +10,000,000,000,000) - truncate_millis - duration.from_millis - instant.absolute)))] + [/ (random.ascii/upper 1)] ($_ _.and - ## (..creation_and_deletion 0) - ## (..read_and_write 1 dataL) + (_.for [/.mock] + ($/.spec (io.io (/.mock /)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_2"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (n.= file_size read_size))))] - ## (_.assert "Can read file size." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_3"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## _ (!.use (\ file append) dataR) - ## content (!.use (\ file content) []) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (and (n.= (n.* 2 file_size) read_size) - ## (\ binary.equivalence = - ## dataL - ## (try.assume (binary.slice 0 file_size content))) - ## (\ binary.equivalence = - ## dataR - ## (try.assume (binary.slice file_size (n.- file_size read_size) content)))))))] - ## (_.assert "Can append to files." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_dir_4"] - ## result (promise.future - ## (do (try.with io.monad) - ## [#let [check_existence! (: (IO (Try Bit)) - ## (try.lift io.monad (/.exists? io.monad /.default path)))] - ## pre! check_existence! - ## dir (!.use (\ /.default create_directory) path) - ## post! check_existence! - ## _ (!.use (\ dir discard) []) - ## remains? check_existence!] - ## (wrap (and (not pre!) - ## post! - ## (not remains?)))))] - ## (_.assert "Can create/delete directories." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [file_path "temp_file_5" - ## dir_path "temp_dir_5"] - ## result (promise.future - ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create_directory) dir_path) - ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) - ## _ (!.use (\ file over_write) dataL) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) []) - ## _ (!.use (\ dir discard) [])] - ## (wrap (n.= file_size read_size))))] - ## (_.assert "Can create files inside of directories." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [file_path "temp_file_6" - ## dir_path "temp_dir_6" - ## inner_dir_path "inner_temp_dir_6"] - ## result (promise.future - ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create_directory) dir_path) - ## pre_files (!.use (\ dir files) []) - ## pre_directories (!.use (\ dir directories) []) - - ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) - ## inner_dir (!.use (\ /.default create_directory) (format dir_path "/" inner_dir_path)) - ## post_files (!.use (\ dir files) []) - ## post_directories (!.use (\ dir directories) []) - - ## _ (!.use (\ file delete) []) - ## _ (!.use (\ inner_dir discard) []) - ## _ (!.use (\ dir discard) [])] - ## (wrap (and (and (n.= 0 (list.size pre_files)) - ## (n.= 0 (list.size pre_directories))) - ## (and (n.= 1 (list.size post_files)) - ## (n.= 1 (list.size post_directories)))))))] - ## (_.assert "Can list files/directories inside a directory." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_7"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## _ (!.use (\ file modify) new_modified) - ## current_modified (!.use (\ file last_modified) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (\ instant.equivalence = new_modified current_modified))))] - ## (_.assert "Can change the time of last modification." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path0 (format "temp_file_8+0") - ## path1 (format "temp_file_8+1")] - ## result (promise.future - ## (do (try.with io.monad) - ## [#let [check_existence! (: (_> Path (IO (Try Bit))) - ## (|>> (/.exists? io.monad /.default) - ## (try.lift io.monad)))] - ## file0 (!.use (\ /.default create_file) path0) - ## _ (!.use (\ file0 over_write) dataL) - ## pre! (check_existence! path0) - ## file1 (: (IO (Try (File IO))) ## TODO: Remove : - ## (!.use (\ file0 move) path1)) - ## post! (check_existence! path0) - ## confirmed? (check_existence! path1) - ## _ (!.use (\ file1 delete) [])] - ## (wrap (and pre! - ## (not post!) - ## confirmed?))))] - ## (_.assert "Can move a file from one path to another." - ## (try.default #0 result)))) - /watch.test )))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index 9c1b31811..57511136e 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -5,12 +5,12 @@ [predicate (#+ Predicate)] [monad (#+ do)]] [control - ["." try] + ["." try (#+ Try)] ["." exception] [concurrency - ["." promise]]] + ["." promise (#+ Promise)]]] [data - ["." binary ("#\." equivalence)] + ["." binary (#+ Binary) ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection @@ -18,10 +18,11 @@ [math ["." random (#+ Random) ("#\." monad)]]] {1 - ["." /]} + ["." / + ["/#" //]]} [//// [data - ["_." binary]]]) + ["$." binary]]]) (def: concern (Random [/.Concern (Predicate /.Concern)]) @@ -87,6 +88,66 @@ false))))) ))) +(def: (no_events_prior_to_creation! fs watcher directory) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do {! (try.with promise.monad)} + [_ (\ fs make_directory directory) + _ (\ watcher start /.all directory)] + (|> (\ watcher poll []) + (\ ! map list.empty?)))) + +(def: (after_creation! fs watcher expected_path) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (: (Promise (Try Any)) + (//.make_file promise.monad fs (binary.create 0) expected_path)) + poll/pre (\ watcher poll []) + poll/post (\ watcher poll [])] + (wrap (and (case poll/pre + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (/.creation? concern) + (not (/.modification? concern)) + (not (/.deletion? concern)))) + + _ + false) + (list.empty? poll/post))))) + +(def: (after_modification! fs watcher data expected_path) + (-> (//.System Promise) (/.Watcher Promise) Binary //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) + _ (\ fs write data expected_path) + poll/2 (\ watcher poll []) + poll/2' (\ watcher poll [])] + (wrap (and (case poll/2 + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (not (/.creation? concern)) + (/.modification? concern) + (not (/.deletion? concern)))) + + _ + false) + (list.empty? poll/2'))))) + +(def: (after_deletion! fs watcher expected_path) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (\ fs delete expected_path) + poll/3 (\ watcher poll []) + poll/3' (\ watcher poll [])] + (wrap (and (case poll/3 + (^ (list [concern actual_path])) + (and (not (/.creation? concern)) + (not (/.modification? concern)) + (/.deletion? concern)) + + _ + false) + (list.empty? poll/3'))))) + (def: #export test Test (<| (_.covering /._) @@ -101,56 +162,20 @@ [fs watcher] (/.mock /)] expected_path (\ ! map (|>> (format directory /)) (random.ascii/alpha 5)) - data (_binary.random 10)] + data ($binary.random 10)] (wrap (do {! promise.monad} [verdict (do (try.with !) - [_ (\ fs create_directory directory) - _ (\ watcher start /.all directory) - poll/0 (\ watcher poll []) - #let [no_events_prior_to_creation! - (list.empty? poll/0)] - file (\ fs create_file expected_path) - poll/1 (\ watcher poll []) - poll/1' (\ watcher poll []) - #let [after_creation! - (and (case poll/1 - (^ (list [actual_path concern])) - (and (text\= expected_path actual_path) - (and (/.creation? concern) - (not (/.modification? concern)) - (not (/.deletion? concern)))) - - _ - false) - (list.empty? poll/1'))] - _ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) - _ (\ file over_write data) - poll/2 (\ watcher poll []) - poll/2' (\ watcher poll []) - #let [after_modification! - (and (case poll/2 - (^ (list [actual_path concern])) - (and (text\= expected_path actual_path) - (and (not (/.creation? concern)) - (/.modification? concern) - (not (/.deletion? concern)))) - - _ - false) - (list.empty? poll/2'))] - _ (\ file delete []) - poll/3 (\ watcher poll []) - poll/3' (\ watcher poll []) - #let [after_deletion! - (and (case poll/3 - (^ (list [actual_path concern])) - (and (not (/.creation? concern)) - (not (/.modification? concern)) - (/.deletion? concern)) - - _ - false) - (list.empty? poll/3'))]] + [no_events_prior_to_creation! + (..no_events_prior_to_creation! fs watcher directory) + + after_creation! + (..after_creation! fs watcher expected_path) + + after_modification! + (..after_modification! fs watcher data expected_path) + + after_deletion! + (..after_deletion! fs watcher expected_path)] (wrap (and no_events_prior_to_creation! after_creation! after_modification! |