aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex
diff options
context:
space:
mode:
Diffstat (limited to '')
-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
13 files changed, 160 insertions, 150 deletions
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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 18:07:26 +0000