aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/abstract/predicate.lux8
-rw-r--r--stdlib/source/lux/control/concurrency/thread.lux97
-rw-r--r--stdlib/source/lux/data/text.lux62
-rw-r--r--stdlib/source/lux/data/text/unicode/set.lux1
-rw-r--r--stdlib/source/lux/math/random.lux1
-rw-r--r--stdlib/source/lux/test.lux46
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux214
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux120
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/jvm.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/scheme.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux4
-rw-r--r--stdlib/source/lux/world/file.lux2104
-rw-r--r--stdlib/source/lux/world/file/watch.lux137
-rw-r--r--stdlib/source/lux/world/net/http/client.lux3
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux45
-rw-r--r--stdlib/source/program/aedifex/command/clean.lux56
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux4
-rw-r--r--stdlib/source/program/aedifex/command/install.lux13
-rw-r--r--stdlib/source/program/aedifex/command/pom.lux33
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux39
-rw-r--r--stdlib/source/program/aedifex/input.lux17
-rw-r--r--stdlib/source/program/aedifex/metadata.lux14
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux7
-rw-r--r--stdlib/source/program/aedifex/metadata/snapshot.lux10
-rw-r--r--stdlib/source/program/aedifex/repository.lux8
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux62
-rw-r--r--stdlib/source/program/aedifex/repository/remote.lux2
-rw-r--r--stdlib/source/program/compositor.lux50
-rw-r--r--stdlib/source/program/compositor/export.lux22
-rw-r--r--stdlib/source/program/compositor/import.lux50
-rw-r--r--stdlib/source/spec/lux/world/file.lux351
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/command/auto.lux93
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux17
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux82
-rw-r--r--stdlib/source/test/aedifex/command/install.lux84
-rw-r--r--stdlib/source/test/aedifex/command/pom.lux37
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux22
-rw-r--r--stdlib/source/test/aedifex/input.lux25
-rw-r--r--stdlib/source/test/aedifex/metadata.lux30
-rw-r--r--stdlib/source/test/aedifex/repository.lux2
-rw-r--r--stdlib/source/test/lux.lux27
-rw-r--r--stdlib/source/test/lux/world/file.lux199
-rw-r--r--stdlib/source/test/lux/world/file/watch.lux131
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!