From c9e452617dc14dfe9955dc556640bc07f319224a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 17 Aug 2020 21:34:07 -0400
Subject: Add local repo installation to Aedifex.

---
 stdlib/source/program/aedifex/cli.lux     | 16 ++++++
 stdlib/source/program/aedifex/local.lux   | 86 +++++++++++++++++++++++++++++++
 stdlib/source/program/aedifex/parser.lux  |  7 +++
 stdlib/source/program/aedifex/pom.lux     |  3 ++
 stdlib/source/program/aedifex/project.lux | 14 +++--
 5 files changed, 123 insertions(+), 3 deletions(-)
 create mode 100644 stdlib/source/program/aedifex/cli.lux
 create mode 100644 stdlib/source/program/aedifex/local.lux

(limited to 'stdlib/source/program/aedifex')

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)})
-- 
cgit v1.2.3