aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex.lux11
-rw-r--r--stdlib/source/program/aedifex/cli.lux14
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux67
-rw-r--r--stdlib/source/program/aedifex/dependency.lux1
-rw-r--r--stdlib/source/program/aedifex/parser.lux8
-rw-r--r--stdlib/source/program/aedifex/project.lux7
-rw-r--r--stdlib/source/program/aedifex/upload.lux100
7 files changed, 200 insertions, 8 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 874e32ceb..bfa2377f4 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -38,7 +38,8 @@
[command
["#." build]
["#." test]
- ["#." auto]]])
+ ["#." auto]
+ ["#." deploy]]])
(def: (read-file! path)
(-> Path (IO (Try Binary)))
@@ -133,12 +134,16 @@
#/cli.POM
(..write-pom! project)
+ #/cli.Dependencies
+ (exec (..fetch-dependencies! project)
+ (wrap []))
+
#/cli.Install
(exec (..install! project)
(wrap []))
- #/cli.Dependencies
- (exec (..fetch-dependencies! project)
+ (#/cli.Deploy repository user password)
+ (exec (/deploy.do! repository user password project)
(wrap []))
(#/cli.Compilation compilation)
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index 3cbb2aae8..b0d210c17 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -2,7 +2,9 @@
[lux #*
[control
["<>" parser
- ["." cli (#+ Parser)]]]])
+ ["." cli (#+ Parser)]]]]
+ [//
+ [upload (#+ User Password)]])
(type: #export Compilation
#Build
@@ -15,8 +17,9 @@
(type: #export Command
#POM
- #Install
#Dependencies
+ #Install
+ (#Deploy Text User Password)
(#Compilation Compilation)
(#Auto Compilation))
@@ -24,8 +27,13 @@
(Parser Command)
($_ <>.or
(cli.this "pom")
- (cli.this "install")
(cli.this "deps")
+ (cli.this "install")
+ (<>.after (cli.this "deploy")
+ ($_ <>.and
+ cli.any
+ cli.any
+ cli.any))
..compilation
(<>.after (cli.this "auto")
..compilation)
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)]))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 7c40bf2ae..92ac3e8ac 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -57,6 +57,7 @@
["tar" lux-library]
["jar" jvm-library]
+ ["pom" pom]
)
(import: #long java/lang/String)
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index bbcbabb95..17191d5cb 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -166,6 +166,11 @@
(Parser Module)
<c>.text)
+(def: deploy-repository
+ (Parser [Text //dependency.Repository])
+ (<c>.tuple (<>.and <c>.text
+ ..repository)))
+
(def: #export project
(Parser /.Project)
(do {@ <>.monad}
@@ -187,4 +192,7 @@
(..singular input "target" <c>.text))
(<>.maybe (..singular input "program" ..module))
(<>.maybe (..singular input "test" ..module))
+ (<| (:: @ map (dictionary.from-list text.hash))
+ (<>.default (list))
+ (..plural input "deploy-repositories" ..deploy-repository))
)))
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index ebd689760..20bbda840 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,7 +1,9 @@
(.module:
[lux (#- Info Source Module)
[data
- ["." text]]
+ ["." text]
+ [collection
+ ["." dictionary (#+ Dictionary)]]]
[world
[net (#+ URL)]
[file (#+ Path)]]
@@ -64,4 +66,5 @@
#sources (List Source)
#target Path
#program (Maybe Module)
- #test (Maybe Module)})
+ #test (Maybe Module)
+ #deploy-repositories (Dictionary Text dependency.Repository)})
diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux
new file mode 100644
index 000000000..8b849ed10
--- /dev/null
+++ b/stdlib/source/program/aedifex/upload.lux
@@ -0,0 +1,100 @@
+(.module:
+ [lux #*
+ ["." host (#+ import:)]
+ [abstract
+ [monad (#+ Monad do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]]
+ [time
+ ["." instant]]
+ [world
+ [net (#+ URL)
+ ["." uri]]]]
+ ["." // #_
+ ["#." dependency (#+ Repository Dependency)]
+ ["#." artifact]])
+
+(type: #export (Action a)
+ (IO (Try a)))
+
+(def: #export monad
+ (:coerce (Monad Action)
+ (try.with io.monad)))
+
+(type: #export User
+ Text)
+
+(type: #export Password
+ Text)
+
+(def: (url repository dependency)
+ (-> Repository Dependency URL)
+ (format repository
+ uri.separator
+ (//artifact.path (get@ #//dependency.artifact dependency))
+ "."
+ (get@ #//dependency.type dependency)))
+
+(import: #long java/lang/AutoCloseable
+ (close [] #io #try void))
+
+(import: #long java/io/OutputStream
+ (flush [] #io #try void)
+ (write [[byte]] #io #try void))
+
+(import: #long java/lang/String)
+
+(import: #long java/net/URLConnection
+ (setDoOutput [boolean] #io #try void)
+ (setRequestProperty [java/lang/String java/lang/String] #io #try void)
+ (getOutputStream [] #io #try java/io/OutputStream))
+
+(import: #long java/net/HttpURLConnection
+ (setRequestMethod [java/lang/String] #io #try void)
+ (getResponseCode [] #io #try int))
+
+(import: #long java/net/URL
+ (new [java/lang/String])
+ (openConnection [] #io #try java/net/URLConnection))
+
+(import: #long java/util/Base64$Encoder
+ (encodeToString [[byte]] java/lang/String))
+
+(import: #long java/util/Base64
+ (#static getEncoder [] java/util/Base64$Encoder))
+
+(exception: #export (failure {code Int})
+ (exception.report
+ ["Code" (%.int code)]))
+
+(def: (basic-auth user password)
+ (-> User Password Text)
+ (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password))
+ (java/util/Base64::getEncoder))))
+
+(def: #export (upload repository user password dependency content)
+ (-> Repository User Password Dependency Binary
+ (Action Any))
+ (do {@ ..monad}
+ [connection (|> (..url repository dependency)
+ java/net/URL::new
+ java/net/URL::openConnection)
+ #let [connection (:coerce java/net/HttpURLConnection connection)]
+ _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection)
+ _ (java/net/URLConnection::setDoOutput true connection)
+ _ (java/net/URLConnection::setRequestProperty "Authorization" (..basic-auth user password) connection)
+ stream (java/net/URLConnection::getOutputStream connection)
+ _ (java/io/OutputStream::write content stream)
+ _ (java/io/OutputStream::flush stream)
+ _ (java/lang/AutoCloseable::close stream)
+ code (java/net/HttpURLConnection::getResponseCode connection)]
+ (case code
+ +200 (wrap [])
+ _ (:: io.monad wrap (exception.throw ..failure [code])))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 13:07:13 +0000