Added deployment code to Aedifex.

1 files changed, 67 insertions, 0 deletions

diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
new file mode 100644
index 000000000..ed6667264
--- /dev/null
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -0,0 +1,67 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." exception (#+ exception:)]
+    [concurrency
+     ["." promise ("#@." monad)]]]
+   [data
+    [binary (#+ Binary)]
+    [text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." dictionary (#+ Dictionary)]]
+    [format
+     ["." binary]
+     ["." tar]
+     ["." xml]]]
+   [world
+    ["." file]]]
+  [program
+   [compositor
+    ["." export]]]
+  ["." /// #_
+   ["/" project (#+ Project)]
+   ["//" upload (#+ User Password)]
+   ["#." action (#+ Action)]
+   ["#." command (#+ Command)]
+   ["#." dependency]
+   ["#." pom]
+   ["#." hash]])
+
+(exception: #export (cannot-find-repository {repository Text}
+                                            {options (Dictionary Text ///dependency.Repository)})
+  (exception.report
+   ["Repository" (%.text repository)]
+   ["Options" (exception.enumerate (function (_ [name repo])
+                                     (format (%.text name) " := " (%.text repo)))
+                                   (dictionary.entries options))]))
+
+(def: #export (do! repository user password project)
+  (-> Text User Password (Command Any))
+  (case (dictionary.get repository (get@ #/.deploy-repositories project))
+    (#.Some repository)
+    (let [artifact (get@ #/.identity project)
+          deploy! (: (-> ///dependency.Type Binary (Action Any))
+                     (function (_ type content)
+                       (promise.future
+                        (//.upload repository
+                                   user
+                                   password
+                                   {#///dependency.artifact artifact
+                                    #///dependency.type type}
+                                   content))))]
+      (do {@ ///action.monad}
+        [library (:: @ map (binary.run tar.writer)
+                     (export.library (file.async file.system)
+                                     (get@ #/.sources project)))
+         _ (deploy! ///dependency.pom (|> project ///pom.project (:: xml.codec encode) encoding.to-utf8))
+         _ (deploy! ///dependency.lux-library library)
+         _ (deploy! "sha1" (///hash.sha1 library))
+         _ (deploy! "md5" (///hash.md5 library))]
+        (wrap [])))
+    
+    #.None
+    (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories project)]))))