From 9af671a34728b35c48bff2ba163c371dc5084946 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 10 Dec 2020 22:29:32 -0400
Subject: Render XML to text in an indented form for human readability.
---
stdlib/source/program/aedifex/cache.lux | 85 ++++++++++++-----------
stdlib/source/program/aedifex/command/build.lux | 13 ++--
stdlib/source/program/aedifex/command/deps.lux | 9 +--
stdlib/source/program/aedifex/command/install.lux | 29 ++++----
stdlib/source/program/aedifex/local.lux | 12 ++--
5 files changed, 79 insertions(+), 69 deletions(-)
(limited to 'stdlib/source/program/aedifex')
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)))
--
cgit v1.2.3