diff options
Diffstat (limited to 'stdlib/source/program')
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 111 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cache.lux | 85 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deps.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/install.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/export.lux | 5 |
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) |