diff options
Diffstat (limited to 'stdlib/source/program/aedifex')
| -rw-r--r-- | stdlib/source/program/aedifex/artifact.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy/release.lux | 173 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy/snapshot.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/format.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/pom.lux | 91 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/profile.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository/local.lux | 28 |
9 files changed, 267 insertions, 71 deletions
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 ? |