Add local repo installation to Aedifex.

6 files changed, 156 insertions, 18 deletions

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index fd269f71f..6909704dd 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -10,7 +10,9 @@
      ["." cli (#+ program:)]
      ["<c>" code]]
     [security
-     ["!" capability]]]
+     ["!" capability]]
+    [concurrency
+     ["." promise]]]
    [data
     [binary (#+ Binary)]
     ["." text
@@ -28,7 +30,9 @@
   ["." / #_
    ["#" project]
    ["#." parser]
-   ["#." pom]])
+   ["#." pom]
+   ["#." cli]
+   ["#." local]])
 
 (def: (read-file! path)
   (-> Path (IO (Try Binary)))
@@ -67,22 +71,36 @@
             [..read-code]
             [(list) (<c>.run /parser.project)])))
 
-(program: [project-file]
+(program: [{command /cli.command}]
   (do {@ io.monad}
-    [data (..read-file! project-file)]
+    [data (..read-file! /.file)]
     (case data
       (#try.Success data)
       (case (..project data)
-        (#try.Success value)
-        (do @
-          [outcome (..write-pom! /pom.file value)]
-          (case outcome
-            (#try.Success value)
-            (wrap (log! "Successfully wrote POM file!"))
-            
-            (#try.Failure error)
-            (wrap (log! (format "Could not write POM file:" text.new-line
-                                error)))))
+        (#try.Success project)
+        (case command
+          #/cli.POM
+          (do @
+            [outcome (..write-pom! /pom.file project)]
+            (case outcome
+              (#try.Success value)
+              (wrap (log! "Successfully wrote POM file!"))
+              
+              (#try.Failure error)
+              (wrap (log! (format "Could not write POM file:" text.new-line
+                                  error)))))
+          
+          #/cli.Install
+          (exec (do promise.monad
+                  [outcome (/local.install (file.async file.system) project)]
+                  (wrap (case outcome
+                          (#try.Success _)
+                          (log! "Successfully installed locally!")
+                          
+                          (#try.Failure error)
+                          (log! (format "Could not install locally:" text.new-line
+                                        error)))))
+            (wrap [])))
         
         (#try.Failure error)
         (wrap (log! (format "Invalid format file:" text.new-line
@@ -90,4 +108,4 @@
       
       (#try.Failure error)
       (wrap (log! (format "Could not read file: "
-                          (%.text project-file)))))))
+                          (%.text /.file)))))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
new file mode 100644
index 000000000..5f75cac9b
--- /dev/null
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -0,0 +1,16 @@
+(.module:
+  [lux #*
+   [control
+    ["<>" parser
+     ["." cli (#+ Parser)]]]])
+
+(type: #export Command
+  #POM
+  #Install)
+
+(def: #export command
+  (Parser Command)
+  ($_ <>.or
+      (cli.this "pom")
+      (cli.this "install")
+      ))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
new file mode 100644
index 000000000..15d9a9323
--- /dev/null
+++ b/stdlib/source/program/aedifex/local.lux
@@ -0,0 +1,86 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    [binary (#+ Binary)]
+    ["." text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." list ("#@." monoid)]]
+    [format
+     ["." binary]
+     ["." tar]
+     ["." xml]]]
+   [world
+    ["." file (#+ Path File Directory)]]]
+  [program
+   [compositor
+    ["." export]]]
+  ["." // #_
+   ["#." project (#+ Project)]
+   ["#." pom]
+   ["#." dependency]])
+
+(def: group-separator
+  ".")
+
+(def: (local system)
+  (All [a] (-> (file.System a) Path))
+  (format "~" (:: system separator) ".m2"))
+
+(def: (repository system)
+  (All [a] (-> (file.System a) Path))
+  (format (..local system) (:: system separator) "repository"))
+
+(def: (guarantee-repository! system project)
+  (-> (file.System Promise) Project (Promise (Try Path)))
+  (do {@ (try.with promise.monad)}
+    [_ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system (..local system)))
+     #let [root (..repository system)
+           identity (get@ #//project.identity project)]
+     _ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system root))]
+    (monad.fold @
+                (function (_ child parent)
+                  (do @
+                    [#let [path (format parent (:: system separator) child)]
+                     _ (: (Promise (Try (Directory Promise)))
+                          (file.get-directory promise.monad system path))]
+                    (wrap path)))
+                root
+                (list@compose (|> identity
+                                  (get@ #//project.group)
+                                  (text.split-all-with ..group-separator))
+                              (list (get@ #//project.name identity)
+                                    (get@ #//project.version identity))))))
+
+(def: (save! system content file)
+  (-> (file.System Promise) Binary Path (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system file))]
+    (!.use (:: file over-write) [content])))
+
+(def: #export (install system project)
+  (-> (file.System Promise) Project (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [repository (..guarantee-repository! system project)
+     #let [identity (get@ #//project.identity project)
+           artifact-name (format repository
+                                 (:: system separator) (get@ #//project.name identity)
+                                 "-" (get@ #//project.version identity))]
+     package (export.library system (get@ #//project.sources project))
+     _ (..save! system (binary.run tar.writer package)
+                (format artifact-name "." //dependency.lux-library))]
+    (..save! system (|> project //pom.project (:: xml.codec encode) encoding.to-utf8)
+             (format artifact-name //pom.extension))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index f3bdbe34f..1a4b2f638 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -121,6 +121,10 @@
        (<>.default //dependency.lux-library ..type)
        )))
 
+(def: source
+  (Parser /.Source)
+  <c>.text)
+
 (def: #export project
   (Parser /.Project)
   (<| <c>.form
@@ -137,4 +141,7 @@
               (<| (<>.default (list))
                   (..bundle (' #dependencies))
                   ..dependency)
+              (<| (<>.default (list "source"))
+                  (..bundle (' #sources))
+                  ..source)
               ))))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index d19ec5902..102728e1e 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -16,6 +16,9 @@
 (def: #export file
   "pom.xml")
 
+(def: #export extension
+  ".pom")
+
 (def: version
   XML
   (#_.Node ["" "modelVersion"] _.attrs
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index a0891951f..9f98ebc51 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,10 +1,14 @@
 (.module:
-  [lux (#- Name Info)
+  [lux (#- Name Info Source)
    [world
-    [net (#+ URL)]]]
+    [net (#+ URL)]
+    [file (#+ Path)]]]
   [//
    ["." dependency]])
 
+(def: #export file
+  "project.lux")
+
 (type: #export Group
   Text)
 
@@ -61,8 +65,12 @@
 (type: #export Dependency
   [Artifact dependency.Type])
 
+(type: #export Source
+  Path)
+
 (type: #export Project
   {#identity Artifact
    #info Info
    #repositories (List Repository)
-   #dependencies (List Dependency)})
+   #dependencies (List Dependency)
+   #sources (List Source)})