Can now deploy releases with Aedifex.

10 files changed, 274 insertions, 76 deletions

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 0c04ff7bb..b964e8fef 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -69,6 +69,10 @@
        set.list
        (list#each (|>> (/repository/remote.repository http.default {.#None}) /repository.async))))
 
+(def: program (program.async program.default))
+(def: fs (file.async file.default))
+(def: local (/repository/local.repository ..program ..fs))
+
 (def: (with_dependencies program console command profile)
   (All (_ a)
     (-> (Program Async) (Console Async)
@@ -146,10 +150,6 @@
               (maybe.trusted (text.clip 0 (-- (text.size it)) it))
               it)))))
 
-(def: program (program.async program.default))
-(def: fs (file.async file.default))
-(def: local (/repository/local.repository ..program ..fs))
-
 (program: [[profiles operation] /cli.command]
   (do [! io.monad]
     [console (# ! each (|>> (try.else ..write_only) console.async)
@@ -189,7 +189,9 @@
                {.#Some artifact}
                (case (dictionary.value repository (the /.#deploy_repositories profile))
                  {.#Some remote}
-                 (/command/deploy.do! console
+                 (/command/deploy.do! ..program
+                                      (shell.async shell.default)
+                                      console
                                       ..local
                                       (/repository.async (/repository/remote.repository http.default {.#Some identity} remote))
                                       (file.async file.default)
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index c1c707a98..cc90d0b78 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -91,14 +91,17 @@
       (text.all_split_by ..group_separator)
       (text.interposed separator)))
 
-(def: .public (uri version artifact)
+(def: .public (bundle version artifact)
   (-> Version Artifact URI)
   (let [/ uri.separator
         group (..directory / (the #group artifact))
-        name (the #name artifact)
-        ... version (the #version artifact)
-        identity (..identity artifact)]
-    (%.format group / name / version / identity)))
+        name (the #name artifact)]
+    (%.format group / name / version)))
+
+(def: .public (uri version artifact)
+  (-> Version Artifact URI)
+  (let [/ uri.separator]
+    (%.format (..bundle version artifact) / (..identity artifact))))
 
 (def: .public (local artifact)
   (-> Artifact (List Text))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 4ff3b9011..504a9206f 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -8,25 +8,29 @@
     [concurrency
      [async {"+" Async}]]]
    [world
+    [program {"+" Program}]
+    [shell {"+" Shell}]
     ["[0]" file]
     ["[0]" console {"+" Console}]]]]
  ["[0]" / "_"
   ["[1][0]" snapshot]
+  ["[1][0]" release]
   ["/[1]" // "_"
-   ["[1][0]" install]
    ["/[1]" // "_"
     [command {"+" Command}]
     [repository {"+" Repository}]
     [artifact {"+" Artifact}]
+    ["/" profile]
     ["[1][0]" action]]]])
 
 (def: .public success
   "Successfully deployed the project.")
 
-(def: .public (do! console local remote fs artifact profile)
-  (-> (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any))
+(def: .public (do! program shell console local remote fs artifact profile)
+  (-> (Program Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any))
   (do [! ///action.monad]
-    [_ (//install.do! console fs local profile)
-     _ (/snapshot.do! console remote fs artifact profile)]
+    [_ (if (/snapshot.snapshot? artifact)
+         (/snapshot.do! console remote fs artifact profile)
+         (/release.do! program shell console local remote fs artifact profile))]
     (is (Async (Try Any))
         (console.write_line ..success console))))
diff --git a/stdlib/source/program/aedifex/command/deploy/release.lux b/stdlib/source/program/aedifex/command/deploy/release.lux
new file mode 100644
index 000000000..b8b6e2531
--- /dev/null
+++ b/stdlib/source/program/aedifex/command/deploy/release.lux
@@ -0,0 +1,173 @@
+(.using
+ [library
+  [lux "*"
+   ["[0]" ffi {"+" import:}]
+   [abstract
+    [predicate {"+" Predicate}]
+    ["[0]" monad {"+" do}]]
+   [control
+    ["[0]" pipe]
+    ["[0]" try {"+" Try}]
+    ["[0]" io {"+" IO}]
+    [concurrency
+     ["[0]" async {"+" Async}]]
+    [parser
+     ["[0]" environment]]]
+   [data
+    ["[0]" binary {"+" Binary}]
+    ["[0]" text
+     ["%" format]
+     [encoding
+      ["[0]" utf8]]]
+    [collection
+     ["[0]" set]
+     ["[0]" dictionary]]
+    [format
+     ["[0]" binary]
+     ["[0]" tar]
+     ["[0]" xml]]]
+   [tool
+    [compiler
+     [meta
+      ["[0]" export]
+      ["[0]" archive]
+      ["[0]" context]
+      ["[0]" packager "_"
+       ["[1]" jvm]]]]]
+   [world
+    [program {"+" Program}]
+    [console {"+" Console}]
+    ["[0]" shell {"+" Shell}]
+    ["[0]" file]]]]
+ ["[0]" // "_"
+  ["[1][0]" snapshot]
+  ["/[1]" // "_"
+   ["[1][0]" install]
+   ["/[1]" // "_"
+    [command {"+" Command}]
+    ["/" profile]
+    ["[1][0]" action]
+    ["[1][0]" pom]
+    ["[1][0]" package]
+    ["[1][0]" hash]
+    ["[1][0]" dependency "_"
+     ["[1]/[0]" deployment]
+     ["[1]/[0]" status]]
+    ["[1][0]" repository {"+" Repository}
+     ["[1]/[0]" origin]
+     ["[1]/[0]" local]]
+    ["[1][0]" artifact {"+" Artifact}
+     ["[1]/[0]" type]
+     ["[1]/[0]" extension {"+" Extension}]]]]])
+
+(import: java/lang/String
+  "[1]::[0]"
+  (toLowerCase [] java/lang/String))
+
+(import: java/lang/System
+  "[1]::[0]"
+  ("static" getProperty [java/lang/String] "io" "try" java/lang/String))
+
+(def: windows?
+  (IO (Try Bit))
+  (# (try.with io.monad) each
+     (|>> java/lang/String::toLowerCase ffi.of_string (text.starts_with? "windows"))
+     (java/lang/System::getProperty (ffi.as_string "os.name"))))
+
+(def: dummy_jar
+  Binary
+  (|> (packager.package (context.jvm "")
+                        (dictionary.empty text.hash)
+                        archive.empty
+                        {.#None})
+      try.trusted
+      (pipe.case
+        {.#Left it}
+        it
+        
+        {.#Right _}
+        (undefined))))
+
+(template [<name> <extension>]
+  [(def: <name>
+     (-> Text Text)
+     (text.suffix <extension>))]
+
+  [asc ".asc"]
+  [pom ////artifact/extension.pom]
+  [tar ////artifact/extension.lux_library]
+  [jar ////artifact/extension.jvm_library]
+  [md5 ////artifact/extension.md5]
+  )
+
+(template [<name> <suffix>]
+  [(def: <name>
+     (-> Text Text)
+     (|>> (text.suffix <suffix>) ..jar))]
+
+  [javadoc "-javadoc"]
+  [sources "-sources"]
+  )
+
+(def: .public release?
+  (Predicate Artifact)
+  (|>> //snapshot.snapshot? not))
+
+(def: (install_dummies! program local fs artifact)
+  (-> (Program Async) (Repository Async) (file.System Async) Artifact (Async (Try Any)))
+  (do (try.with async.monad)
+    [.let [$artifact (////artifact.uri (the ////artifact.#version artifact) artifact)]
+     _ (# local upload (..jar $artifact) ..dummy_jar)
+     _ (# local upload (..javadoc $artifact) ..dummy_jar)
+     _ (# local upload (..sources $artifact) ..dummy_jar)]
+    (in [])))
+
+(def: (signed it)
+  (-> Text [Text Text])
+  [it (..asc it)])
+
+(def: (release_unsigned_artifact! local remote uri)
+  (-> (Repository Async) (Repository Async) Text (Async (Try Binary)))
+  (do [! ////action.monad]
+    [it (# local download uri)
+     _ (# remote upload uri it)]
+    (in it)))
+
+(def: (release_signed_artifact! local remote [artifact signature])
+  (-> (Repository Async) (Repository Async) [Text Text] (Async (Try Any)))
+  (do [! ////action.monad]
+    [it (..release_unsigned_artifact! local remote artifact)
+     _ (|> it
+           ////hash.md5
+           (# ////hash.md5_codec encoded)
+           (# utf8.codec encoded)
+           (# remote upload (..md5 artifact)))
+     _ (..release_unsigned_artifact! local remote signature)]
+    (in [])))
+
+(def: .public (do! program shell console local remote fs artifact profile)
+  (-> (Program Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any))
+  (do [! ////action.monad]
+    [_ (///install.do! console fs local profile)
+     _ (install_dummies! program local fs artifact)
+     .let [working_directory (# program directory)
+           @root (////repository/local.root program fs)
+           $bundle (////artifact.bundle (the ////artifact.#version artifact) artifact)
+           / (# fs separator)
+           @local (%.format @root / $bundle)]
+     windows? (async.future ..windows?)
+     process (is (Async (Try (shell.Process Async)))
+                 (# shell execute [environment.empty @local
+                                   (if windows?
+                                     ["cmd" (list "/c" "for %file in (.\*) do gpg.exe -ab %file")]
+                                     ["sh" (list "-c" "for file in *.*; do gpg -ab $file; done")])]))
+     exit (is (Async (Try shell.Exit))
+              (# process await []))
+     .let [$artifact (////artifact.uri (the ////artifact.#version artifact) artifact)]
+     _ (monad.each ! (release_signed_artifact! local remote)
+                   (list (..signed (..pom $artifact))
+                         (..signed (..tar $artifact))
+                         (..signed (..jar $artifact))
+                         (..signed (..javadoc $artifact))
+                         (..signed (..sources $artifact))))]
+    (in [])))
diff --git a/stdlib/source/program/aedifex/command/deploy/snapshot.lux b/stdlib/source/program/aedifex/command/deploy/snapshot.lux
index 9770965d9..fa69e8311 100644
--- a/stdlib/source/program/aedifex/command/deploy/snapshot.lux
+++ b/stdlib/source/program/aedifex/command/deploy/snapshot.lux
@@ -2,12 +2,13 @@
  [library
   [lux "*"
    [abstract
-    [monad {"+" do}]]
+    [monad {"+" do}]
+    [predicate {"+" Predicate}]]
    [control
     [concurrency
      ["[0]" async {"+" Async}]]]
    [data
-    [text
+    ["[0]" text
      [encoding
       ["[0]" utf8]]]
     [collection
@@ -37,6 +38,11 @@
   ["[1][0]" artifact {"+" Artifact}
    ["[1]/[0]" type]]])
 
+(def: .public snapshot?
+  (Predicate Artifact)
+  (|>> (the ////artifact.#version)
+       (text.contains? "-SNAPSHOT")))
+
 (def: .public (do! console remote fs artifact profile)
   (-> (Console Async) (Repository Async) (file.System Async) Artifact (Command Any))
   (do [! ////action.monad]
diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux
index b7dd105c1..12f676cc7 100644
--- a/stdlib/source/program/aedifex/format.lux
+++ b/stdlib/source/program/aedifex/format.lux
@@ -115,6 +115,7 @@
 (def: (info value)
   (Format /.Info)
   (|> ..empty
+      (..on_maybe "name" (the /.#name value) code.text)
       (..on_maybe "url" (the /.#url value) code.text)
       (..on_maybe "scm" (the /.#scm value) code.text)
       (..on_maybe "description" (the /.#description value) code.text)
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 280c518e7..09ae15ed5 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -127,6 +127,7 @@
               (<code>.tuple (<>.some (<>.and <code>.text
                                              <code>.any))))]
     ($_ <>.and
+        (<>.maybe (..singular input "name" ..name))
         (<>.maybe (..singular input "url" ..url))
         (<>.maybe (..singular input "scm" ..scm))
         (<>.maybe (..singular input "description" ..description))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index 8b4e8e0ed..683e1bb6d 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -94,52 +94,51 @@
   (-> Text (-> (List XML) XML))
   (|>> {_.#Node ["" tag] _.attributes}))
 
-(comment
-  (def: scm
-    (-> /.SCM XML)
-    (|>> (..property ..url_tag)
-         list
-         {_.#Node ["" "scm"] _.attributes}))
-
-  (def: (organization [name url])
-    (-> /.Organization XML)
-    (|> (list (..property "name" name)
-              (..property ..url_tag url))
-        {_.#Node ["" "organization"] _.attributes}))
-
-  (def: (developer_organization [name url])
-    (-> /.Organization (List XML))
-    (list (..property "organization" name)
-          (..property "organizationUrl" url)))
-
-  (def: (developer' [name email organization])
-    (-> /.Developer (List XML))
-    (partial_list (..property "name" name)
-                  (..property "email" email)
-                  (|> organization (maybe#each ..developer_organization) (maybe.else (list)))))
-
-  (template [<name> <type> <tag>]
-    [(def: <name>
-       (-> <type> XML)
-       (|>> ..developer' {_.#Node ["" <tag>] _.attributes}))]
-
-    [developer /.Developer "developer"]
-    [contributor /.Contributor "contributor"]
-    )
-
-  (def: (info value)
-    (-> /.Info (List XML))
-    ($_ list#composite
-        (|> value (the /.#url) (maybe#each (..property ..url_tag)) maybe.list)
-        (|> value (the /.#description) (maybe#each (..property "description")) maybe.list)
-        (|> value (the /.#licenses) (list#each ..license) (..group "licenses") list)
-        (|> value (the /.#scm) (maybe#each ..scm) maybe.list)
-        (|> value (the /.#organization) (maybe#each ..organization) maybe.list)
-        (|> value (the /.#developers) (list#each ..developer) (..group "developers") list)
-        (|> value (the /.#contributors) (list#each ..contributor) (..group "contributors") list)
-        ))
+(def: scm
+  (-> /.SCM XML)
+  (|>> (..property ..url_tag)
+       list
+       {_.#Node ["" "scm"] _.attributes}))
+
+(def: (organization [name url])
+  (-> /.Organization XML)
+  (|> (list (..property "name" name)
+            (..property ..url_tag url))
+      {_.#Node ["" "organization"] _.attributes}))
+
+(def: (developer_organization [name url])
+  (-> /.Organization (List XML))
+  (list (..property "organization" name)
+        (..property "organizationUrl" url)))
+
+(def: (developer' [name email organization])
+  (-> /.Developer (List XML))
+  (partial_list (..property "name" name)
+                (..property "email" email)
+                (|> organization (maybe#each ..developer_organization) (maybe.else (list)))))
+
+(template [<name> <type> <tag>]
+  [(def: <name>
+     (-> <type> XML)
+     (|>> ..developer' {_.#Node ["" <tag>] _.attributes}))]
+
+  [developer /.Developer "developer"]
+  [contributor /.Contributor "contributor"]
   )
 
+(def: (info value)
+  (-> /.Info (List XML))
+  ($_ list#composite
+      (|> value (the /.#name) (maybe#each (..property "name")) maybe.list)
+      (|> value (the /.#url) (maybe#each (..property ..url_tag)) maybe.list)
+      (|> value (the /.#description) (maybe#each (..property "description")) maybe.list)
+      (|> value (the /.#licenses) (list#each ..license) (..group "licenses") list)
+      (|> value (the /.#scm) (maybe#each ..scm) maybe.list)
+      (|> value (the /.#organization) (maybe#each ..organization) maybe.list)
+      (|> value (the /.#developers) (list#each ..developer) (..group "developers") list)
+      (|> value (the /.#contributors) (list#each ..contributor) (..group "contributors") list)
+      ))
+
 (def: .public (write value)
   (-> /.Profile (Try XML))
   (case (the /.#identity value)
@@ -149,6 +148,10 @@
               ($_ list#composite
                   (list ..version)
                   (..artifact identity)
+                  (|> value
+                      (the /.#info)
+                      (maybe#each ..info)
+                      (maybe.else (list)))
                   (|> value (the /.#repositories) set.list (list#each ..repository) (..group "repositories") list)
                   (|> value (the /.#dependencies) set.list (list#each ..dependency) (..group ..dependencies_tag) list)
                   )}}
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index 8fca5dffa..39f788b4b 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -108,7 +108,8 @@
 
 (type: .public Info
   (Record
-   [#url (Maybe URL)
+   [#name (Maybe Text)
+    #url (Maybe URL)
     #scm (Maybe SCM)
     #description (Maybe Text)
     #licenses (List License)
@@ -122,6 +123,7 @@
       (maybe.equivalence text.equivalence)
       (maybe.equivalence text.equivalence)
       (maybe.equivalence text.equivalence)
+      (maybe.equivalence text.equivalence)
       (list.equivalence ..license_equivalence)
       (maybe.equivalence ..organization_equivalence)
       (list.equivalence ..developer_equivalence)
@@ -129,7 +131,8 @@
 
 (def: .public default_info
   Info
-  [#url {.#None}
+  [#name {.#None}
+   #url {.#None}
    #scm {.#None}
    #description {.#None}
    #licenses (list)
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index ada14650b..2c6ff8b9b 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -20,35 +20,37 @@
    ["[1][0]" local]
    ["[1][0]" metadata]]])
 
-(def: (root program /)
-  (-> (Program Async) Text file.Path)
-  (|> ///local.repository
-      (text.replaced uri.separator /)
-      (format (# program home) /)))
+(def: .public (root program fs)
+  (-> (Program Async) (file.System Async) file.Path)
+  (let [/ (# fs separator)]
+    (|> ///local.repository
+        (text.replaced uri.separator /)
+        (format (# program home) /))))
 
 (def: (path /)
   (-> Text (-> URI file.Path))
   (text.replaced uri.separator /))
 
-(def: (absolute_path program /)
-  (-> (Program Async) Text (-> URI file.Path))
-  (|>> ///metadata.local_uri
-       (..path /)
-       (format (..root program /) /)))
+(def: (absolute_path program fs)
+  (-> (Program Async) (file.System Async) (-> URI file.Path))
+  (let [/ (# fs separator)]
+    (|>> ///metadata.local_uri
+         (..path /)
+         (format (..root program fs) /))))
 
 (implementation: .public (repository program fs)
   (-> (Program Async) (file.System Async) (//.Repository Async))
 
   (def: description
-    (..root program (# fs separator)))
+    (..root program fs))
 
   (def: download
-    (|>> (..absolute_path program (# fs separator))
+    (|>> (..absolute_path program fs)
          (# fs read)))
 
   (def: (upload uri content)
     (do [! async.monad]
-      [.let [absolute_path (..absolute_path program (# fs separator) uri)]
+      [.let [absolute_path (..absolute_path program fs uri)]
        ? (# fs file? absolute_path)
        _ (is (Async (Try Any))
              (if ?