aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex.lux111
-rw-r--r--stdlib/source/program/aedifex/cache.lux85
-rw-r--r--stdlib/source/program/aedifex/command/build.lux13
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux9
-rw-r--r--stdlib/source/program/aedifex/command/install.lux29
-rw-r--r--stdlib/source/program/aedifex/local.lux12
-rw-r--r--stdlib/source/program/compositor/export.lux5
7 files changed, 139 insertions, 125 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index aac616597..41d7f9b2f 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -65,14 +65,14 @@
set.to-list
(list\map (|>> /repository.remote /repository.async))))
-(def: (with-dependencies console command profile)
+(def: (with-dependencies program console command profile)
(All [a]
- (-> (Console Promise)
+ (-> (Program Promise) (Console Promise)
(-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a))
(Command a)))
(do /action.monad
- [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)]
- ((command console (program.async program.default) (file.async file.default) (shell.async shell.default) resolution) profile)))
+ [resolution (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)]
+ ((command console program (file.async file.default) (shell.async shell.default) resolution) profile)))
(exception: (cannot-find-repository {repository Text}
{options (Dictionary Text Address)})
@@ -118,61 +118,62 @@
(\ program.default exit shell.error))
(#try.Success profile)
- (case operation
- #/cli.Version
- (wrap [])
-
- #/cli.Clean
- (..command
- (/command/clean.do! console (file.async file.default) profile))
+ (let [program (program.async program.default)]
+ (case operation
+ #/cli.Version
+ (wrap [])
+
+ #/cli.Clean
+ (..command
+ (/command/clean.do! console (file.async file.default) profile))
- #/cli.POM
- (..command
- (/command/pom.do! console (file.async file.default) profile))
-
- #/cli.Install
- (..command
- (/command/install.do! console (file.async file.default) profile))
+ #/cli.POM
+ (..command
+ (/command/pom.do! console (file.async file.default) profile))
+
+ #/cli.Install
+ (..command
+ (/command/install.do! program console (file.async file.default) profile))
- (#/cli.Deploy repository identity)
- (..command
- (case [(get@ #/.identity profile)
- (dictionary.get repository (get@ #/.deploy-repositories profile))]
- [(#.Some artifact) (#.Some repository)]
- (/command/deploy.do! console
- (/repository.async (/repository.remote repository))
- (file.async file.default)
- identity
- artifact
- profile)
+ (#/cli.Deploy repository identity)
+ (..command
+ (case [(get@ #/.identity profile)
+ (dictionary.get repository (get@ #/.deploy-repositories profile))]
+ [(#.Some artifact) (#.Some repository)]
+ (/command/deploy.do! console
+ (/repository.async (/repository.remote repository))
+ (file.async file.default)
+ identity
+ artifact
+ profile)
- [#.None _]
- (promise\wrap (exception.throw /.no-identity []))
+ [#.None _]
+ (promise\wrap (exception.throw /.no-identity []))
- [_ #.None]
- (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))))
-
- #/cli.Dependencies
- (..command
- (/command/deps.do! console (file.async file.default) (..repositories profile) profile))
+ [_ #.None]
+ (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))))
+
+ #/cli.Dependencies
+ (..command
+ (/command/deps.do! program console (file.async file.default) (..repositories profile) profile))
- (#/cli.Compilation compilation)
- (case compilation
- #/cli.Build (..command
- (..with-dependencies console /command/build.do! profile))
- #/cli.Test (..command
- (..with-dependencies console /command/test.do! profile)))
+ (#/cli.Compilation compilation)
+ (case compilation
+ #/cli.Build (..command
+ (..with-dependencies program console /command/build.do! profile))
+ #/cli.Test (..command
+ (..with-dependencies program console /command/test.do! profile)))
- (#/cli.Auto auto)
- (do !
- [?watcher watch.default]
- (case ?watcher
- (#try.Failure error)
- (wrap (log! error))
-
- (#try.Success watcher)
- (..command
- (case auto
- #/cli.Build (..with-dependencies console (/command/auto.do! watcher /command/build.do!) profile)
- #/cli.Test (..with-dependencies console (/command/auto.do! watcher /command/test.do!) profile))))))
+ (#/cli.Auto auto)
+ (do !
+ [?watcher watch.default]
+ (case ?watcher
+ (#try.Failure error)
+ (wrap (log! error))
+
+ (#try.Success watcher)
+ (..command
+ (case auto
+ #/cli.Build (..with-dependencies program console (/command/auto.do! watcher /command/build.do!) profile)
+ #/cli.Test (..with-dependencies program console (/command/auto.do! watcher /command/test.do!) profile)))))))
))))))
diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
index 31403b839..d6a8a70ef 100644
--- a/stdlib/source/program/aedifex/cache.lux
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -22,6 +22,7 @@
[format
["." xml]]]
[world
+ [program (#+ Program)]
["." file (#+ Path File Directory)]]]
["." // #_
["#" local]
@@ -39,42 +40,44 @@
(file.get-file promise.monad system file))]
(!.use (\ file over-write) [content])))
-(def: #export (write-one system [artifact type] package)
- (-> (file.System Promise) Dependency Package (Promise (Try Artifact)))
- (do (try.with promise.monad)
- [directory (: (Promise (Try Path))
- (file.make-directories promise.monad system (//.path system artifact)))
- #let [prefix (format directory (\ system separator) (//artifact.identity artifact))]
- directory (: (Promise (Try (Directory Promise)))
- (file.get-directory promise.monad system directory))
- _ (..write! system
- (get@ #//package.library package)
- (format prefix (//artifact/extension.extension type)))
- _ (..write! system
- (|> package
- (get@ #//package.sha-1)
- (\ //hash.sha-1-codec encode)
- encoding.to-utf8)
- (format prefix //artifact/extension.sha-1))
- _ (..write! system
- (|> package
- (get@ #//package.md5)
- (\ //hash.md5-codec encode)
- encoding.to-utf8)
- (format prefix //artifact/extension.md5))
- _ (..write! system
- (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8)
- (format prefix //artifact/extension.pom))]
- (wrap artifact)))
+(def: #export (write-one program system [artifact type] package)
+ (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
+ (do promise.monad
+ [home (\ program home [])]
+ (do (try.with promise.monad)
+ [directory (: (Promise (Try Path))
+ (file.make-directories promise.monad system (//.path system home artifact)))
+ #let [prefix (format directory (\ system separator) (//artifact.identity artifact))]
+ directory (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system directory))
+ _ (..write! system
+ (get@ #//package.library package)
+ (format prefix (//artifact/extension.extension type)))
+ _ (..write! system
+ (|> package
+ (get@ #//package.sha-1)
+ (\ //hash.sha-1-codec encode)
+ encoding.to-utf8)
+ (format prefix //artifact/extension.sha-1))
+ _ (..write! system
+ (|> package
+ (get@ #//package.md5)
+ (\ //hash.md5-codec encode)
+ encoding.to-utf8)
+ (format prefix //artifact/extension.md5))
+ _ (..write! system
+ (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8)
+ (format prefix //artifact/extension.pom))]
+ (wrap artifact))))
-(def: #export (write-all system resolution)
- (-> (file.System Promise) Resolution (Promise (Try (Set Artifact))))
+(def: #export (write-all program system resolution)
+ (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact))))
(do {! (try.with promise.monad)}
[]
(|> (dictionary.entries resolution)
(list.filter (|>> product.right //package.local? not))
(monad.map ! (function (_ [dependency package])
- (..write-one system dependency package)))
+ (..write-one program system dependency package)))
(\ ! map (set.from-list //artifact.hash)))))
(def: (read! system path)
@@ -92,11 +95,13 @@
(_\map (\ codec decode))
_\join)))
-(def: #export (read-one system [artifact type])
- (-> (file.System Promise) Dependency (Promise (Try Package)))
- (let [prefix (format (//.path system artifact)
- (\ system separator)
- (//artifact.identity artifact))]
+(def: #export (read-one program system [artifact type])
+ (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package)))
+ (do promise.monad
+ [home (\ program home [])
+ #let [prefix (format (//.path system home artifact)
+ (\ system separator)
+ (//artifact.identity artifact))]]
(do (try.with promise.monad)
[pom (..read! system (format prefix //artifact/extension.pom))
library (..read! system (format prefix (//artifact/extension.extension type)))
@@ -113,8 +118,8 @@
#//package.sha-1 sha-1
#//package.md5 md5}))))))
-(def: #export (read-all system dependencies resolution)
- (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
+(def: #export (read-all program system dependencies resolution)
+ (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
(case dependencies
#.Nil
(\ (try.with promise.monad) wrap resolution)
@@ -126,8 +131,8 @@
(wrap (#try.Success package))
#.None
- (..read-one system head))]
- (with-expansions [<next> (as-is (read-all system tail resolution))]
+ (..read-one program system head))]
+ (with-expansions [<next> (as-is (read-all program system tail resolution))]
(case package
(#try.Success package)
(do (try.with promise.monad)
@@ -136,7 +141,7 @@
(\ promise.monad wrap))
resolution (|> resolution
(dictionary.put head package)
- (read-all system (set.to-list sub-dependencies)))]
+ (read-all program system (set.to-list sub-dependencies)))]
<next>)
(#try.Failure error)
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 8960d9c75..de8ceb991 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -101,11 +101,11 @@
_
(exception.throw ..no-available-compiler [])))
-(def: (libraries fs)
- (All [!] (-> (file.System !) Resolution (List Path)))
+(def: (libraries fs home)
+ (All [!] (-> (file.System !) Path Resolution (List Path)))
(|>> dictionary.keys
(list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library)))
- (list\map (|>> (get@ #///dependency.artifact) (///local.path fs)))))
+ (list\map (|>> (get@ #///dependency.artifact) (///local.path fs home)))))
(def: (singular name)
(-> Text Text (List Text))
@@ -132,13 +132,14 @@
[(#.Some program-module) (#.Some target)]
(do promise.monad
[environment (\ program environment [])
+ home (\ program home [])
working-directory (\ program directory [])]
(do ///action.monad
[[resolution compiler] (promise\wrap (..compiler resolution))
#let [[command output] (let [[compiler output] (case compiler
- (#JVM artifact) [(///runtime.java (///local.path fs artifact))
+ (#JVM artifact) [(///runtime.java (///local.path fs home artifact))
"program.jar"]
- (#JS artifact) [(///runtime.node (///local.path fs artifact))
+ (#JS artifact) [(///runtime.node (///local.path fs home artifact))
"program.js"])]
[(format compiler " build") output])
/ (\ fs separator)
@@ -148,7 +149,7 @@
[environment
working-directory
command
- (list.concat (list (..plural "--library" (..libraries fs resolution))
+ (list.concat (list (..plural "--library" (..libraries fs home resolution))
(..plural "--source" (set.to-list (get@ #///.sources profile)))
(..singular "--target" cache-directory)
(..singular "--module" program-module)))])
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
index 67dc19e47..dbb277948 100644
--- a/stdlib/source/program/aedifex/command/deps.lux
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -9,6 +9,7 @@
[collection
["." set (#+ Set)]]]
[world
+ [program (#+ Program)]
["." file]
["." console (#+ Console)]]]
["." // #_
@@ -23,12 +24,12 @@
["#." dependency #_
["#/." resolution (#+ Resolution)]]]])
-(def: #export (do! console fs repositories profile)
- (-> (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution))
+(def: #export (do! program console fs repositories profile)
+ (-> (Program Promise) (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution))
(do ///action.monad
[#let [dependencies (set.to-list (get@ #///.dependencies profile))]
- cache (///cache.read-all fs dependencies ///dependency/resolution.empty)
+ cache (///cache.read-all program fs dependencies ///dependency/resolution.empty)
resolution (///dependency/resolution.all repositories dependencies cache)
- cached (///cache.write-all fs resolution)
+ cached (///cache.write-all program fs resolution)
_ (console.write-line //clean.success console)]
(wrap resolution)))
diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux
index 327a0c119..d11d96a0c 100644
--- a/stdlib/source/program/aedifex/command/install.lux
+++ b/stdlib/source/program/aedifex/command/install.lux
@@ -21,6 +21,7 @@
["." tar]
["." xml]]]
[world
+ [program (#+ Program)]
["." file (#+ Path File)]
["." console (#+ Console)]]]
[program
@@ -47,21 +48,23 @@
(def: #export failure
"Failure: No 'identity' defined for the project.")
-(def: #export (do! console system profile)
- (-> (Console Promise) (file.System Promise) (Command Any))
+(def: #export (do! program console system profile)
+ (-> (Program Promise) (Console Promise) (file.System Promise) (Command Any))
(case (get@ #/.identity profile)
(#.Some identity)
- (do ///action.monad
- [package (export.library system (set.to-list (get@ #/.sources profile)))
- repository (: (Promise (Try Path))
- (file.make-directories promise.monad system (///local.path system identity)))
- #let [artifact-name (format repository (\ system separator) (///artifact.identity identity))]
- _ (..save! system (binary.run tar.writer package)
- (format artifact-name ///artifact/extension.lux-library))
- pom (\ promise.monad wrap (///pom.write profile))
- _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8)
- (format artifact-name ///artifact/extension.pom))]
- (console.write-line //clean.success console))
+ (do promise.monad
+ [home (\ program home [])]
+ (do ///action.monad
+ [package (export.library system (set.to-list (get@ #/.sources profile)))
+ repository (: (Promise (Try Path))
+ (file.make-directories promise.monad system (///local.path system home identity)))
+ #let [artifact-name (format repository (\ system separator) (///artifact.identity identity))]
+ _ (..save! system (binary.run tar.writer package)
+ (format artifact-name ///artifact/extension.lux-library))
+ pom (\ promise.monad wrap (///pom.write profile))
+ _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8)
+ (format artifact-name ///artifact/extension.pom))]
+ (console.write-line //clean.success console)))
_
(console.write-line ..failure console)))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 34547027d..e1927e577 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -8,13 +8,13 @@
["." // #_
["#." artifact (#+ Artifact)]])
-(def: #export (repository system)
- (All [a] (-> (file.System a) Path))
+(def: #export (repository system home)
+ (All [a] (-> (file.System a) Path Path))
(let [/ (\ system separator)]
- (format "~" / ".m2" / "repository")))
+ (format home / ".m2" / "repository")))
-(def: #export (path system artifact)
- (All [a] (-> (file.System a) Artifact Path))
- (format (..repository system)
+(def: #export (path system home artifact)
+ (All [a] (-> (file.System a) Path Artifact Path))
+ (format (..repository system home)
(\ system separator)
(//artifact.path system artifact)))
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
index bc2ced5a3..b649f333b 100644
--- a/stdlib/source/program/compositor/export.lux
+++ b/stdlib/source/program/compositor/export.lux
@@ -54,7 +54,10 @@
source-code (tar.content source-code)]
(wrap (#tar.Normal [path
(instant.from-millis +0)
- tar.none
+ ($_ tar.and
+ tar.read-by-owner tar.write-by-owner
+ tar.read-by-group tar.write-by-group
+ tar.read-by-other)
..no-ownership
source-code])))))
(\ try.monad map row.from-list)