Render XML to text in an indented form for human readability.

5 files changed, 79 insertions, 69 deletions

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)))