aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex.lux36
-rw-r--r--stdlib/source/program/aedifex/cli.lux11
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux72
-rw-r--r--stdlib/source/program/aedifex/dependency.lux22
-rw-r--r--stdlib/source/program/aedifex/repository.lux76
-rw-r--r--stdlib/source/program/aedifex/upload.lux95
6 files changed, 140 insertions, 172 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index d4c9036f3..a9b4c9514 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -4,15 +4,16 @@
[monad (#+ do)]]
[control
[pipe (#+ do>)]
- ["." try (#+ Try)]
["." io (#+ IO)]
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
[parser
["." cli (#+ program:)]
["<c>" code]]
[security
["!" capability]]
[concurrency
- ["." promise (#+ Promise)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]]
[data
[binary (#+ Binary)]
["." text
@@ -21,7 +22,8 @@
[format
["." xml]]
[collection
- ["." set]]]
+ ["." set]
+ ["." dictionary (#+ Dictionary)]]]
[tool
[compiler
[language
@@ -38,6 +40,7 @@
["#." pom]
["#." cli]
["#." cache]
+ ["#." repository (#+ Address)]
["#." dependency #_
["#" resolution]]
["#." command
@@ -70,6 +73,14 @@
(log! (format "Could not resolve dependencies:" text.new-line
error))))))
+(exception: (cannot-find-repository {repository Text}
+ {options (Dictionary Text Address)})
+ (exception.report
+ ["Repository" (%.text repository)]
+ ["Options" (exception.enumerate (function (_ [name repo])
+ (format (%.text name) " := " (%.text repo)))
+ (dictionary.entries options))]))
+
(program: [{[profile operation] /cli.command}]
(do {! io.monad}
[?profile (/input.read io.monad file.default profile)]
@@ -92,10 +103,23 @@
(exec (/command/install.do! (file.async file.default) profile)
(wrap []))
- (#/cli.Deploy repository user password)
- (exec (/command/deploy.do! repository user password profile)
- (wrap []))
+ (#/cli.Deploy repository identity)
+ (exec (case [(get@ #/.identity profile)
+ (dictionary.get repository (get@ #/.deploy-repositories profile))]
+ [(#.Some artifact) (#.Some repository)]
+ (/command/deploy.do! (/repository.async (/repository.default repository))
+ (file.async file.default)
+ identity
+ artifact
+ profile)
+ [#.None _]
+ (promise@wrap (exception.throw /.no-identity []))
+
+ [_ #.None]
+ (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))
+ (wrap []))
+
(#/cli.Compilation compilation)
(case compilation
#/cli.Build (exec (/command/build.do! profile)
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index efc261189..adf52a18b 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -8,7 +8,7 @@
[data
["." text]]]
[//
- [repository (#+ User Password)]
+ [repository (#+ Identity)]
["/" profile (#+ Name)]])
(type: #export Compilation
@@ -36,7 +36,7 @@
#POM
#Dependencies
#Install
- (#Deploy Text User Password)
+ (#Deploy Text Identity)
(#Compilation Compilation)
(#Auto Compilation))
@@ -69,10 +69,9 @@
(cli.this "deps")
(cli.this "install")
(<>.after (cli.this "deploy")
- ($_ <>.and
- cli.any
- cli.any
- cli.any))
+ (<>.and cli.any
+ (<>.and 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
index aa48946bf..a083d8f53 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -3,16 +3,13 @@
[abstract
[monad (#+ do)]]
[control
- ["." exception (#+ exception:)]
[concurrency
- ["." promise ("#@." monad)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]]
[data
[binary (#+ Binary)]
[text
- ["%" format (#+ format)]
["." encoding]]
[collection
- ["." dictionary (#+ Dictionary)]
["." set]]
[format
["." binary]
@@ -24,53 +21,28 @@
[compositor
["." export]]]
["." /// #_
- ["/" profile (#+ Profile)]
- ["//" upload]
+ [repository (#+ Identity Repository)]
+ [command (#+ Command)]
+ ["/" profile]
["#." action (#+ Action)]
- ["#." command (#+ Command)]
["#." pom]
["#." hash]
- ["#." repository (#+ User Password)]
- ["#." artifact
- ["#/." type]]
- ["#." dependency
- ["#/." resolution]]])
+ ["#." artifact (#+ Artifact)
+ ["#/." extension (#+ Extension)]]])
-(exception: #export (cannot-find-repository {repository Text}
- {options (Dictionary Text ///repository.Address)})
- (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 profile)
- (-> Text User Password (Command Any))
- (case [(get@ #/.identity profile)
- (dictionary.get repository (get@ #/.deploy-repositories profile))]
- [#.None _]
- (promise@wrap (exception.throw /.no-identity []))
-
- [_ #.None]
- (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)]))
-
- [(#.Some identity) (#.Some repository)]
- (let [deploy! (: (-> ///artifact/type.Type Binary (Action Any))
- (function (_ type content)
- (promise.future
- (//.upload repository
- user
- password
- {#///dependency.artifact identity
- #///dependency.type type}
- content))))]
- (do {! ///action.monad}
- [library (:: ! map (binary.run tar.writer)
- (export.library (file.async file.default)
- (set.to-list (get@ #/.sources profile))))
- pom (promise@wrap (///pom.write profile))
- _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
- _ (deploy! ///artifact/type.lux-library library)
- _ (deploy! ///artifact/type.sha-1 (///hash.data (///hash.sha-1 library)))
- _ (deploy! ///artifact/type.md5 (///hash.data (///hash.md5 library)))]
- (wrap [])))))
+(def: #export (do! repository fs identity artifact profile)
+ (-> (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
+ (let [deploy! (: (-> Extension Binary (Action Any))
+ (:: repository upload identity artifact))]
+ (do {! ///action.monad}
+ [library (|> profile
+ (get@ #/.sources)
+ set.to-list
+ (export.library fs)
+ (:: ! map (binary.run tar.writer)))
+ pom (promise@wrap (///pom.write profile))
+ _ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
+ _ (deploy! ///artifact/extension.lux-library library)
+ _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library)))
+ _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))]
+ (wrap []))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 629618620..db997ef3b 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -1,30 +1,26 @@
(.module:
[lux (#- Type)
[abstract
- ["." equivalence (#+ Equivalence)]
+ [equivalence (#+ Equivalence)]
["." hash (#+ Hash)]]
[data
- ["." text]]
- [world
- [net (#+ URL)]]]
+ ["." text
+ ["%" format (#+ format)]]]]
["." // #_
- ["#." artifact (#+ Artifact)
+ ["#" artifact (#+ Artifact)
[type (#+ Type)]]])
(type: #export Dependency
{#artifact Artifact
#type Type})
-(def: #export equivalence
- (Equivalence Dependency)
- ($_ equivalence.product
- //artifact.equivalence
- text.equivalence
- ))
-
(def: #export hash
(Hash Dependency)
($_ hash.product
- //artifact.hash
+ //.hash
text.hash
))
+
+(def: #export equivalence
+ (Equivalence Dependency)
+ (:: hash &equivalence))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index f92b1e5b9..0c8f92993 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -1,17 +1,23 @@
(.module:
[lux #*
+ ["." host (#+ import:)]
[abstract
[monad (#+ do)]]
[control
["." io (#+ IO)]
["." try (#+ Try)]
+ ["." exception (#+ exception:)]
[concurrency
["." promise (#+ Promise)]
["." stm]]]
[data
- [binary (#+ Binary)]]
+ [binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]]
[world
- [net (#+ URL)]]]
+ [net (#+ URL)
+ ["." uri]]]]
["." // #_
["#." artifact (#+ Artifact)
["#/." extension (#+ Extension)]]])
@@ -83,3 +89,69 @@
(#try.Failure error)
(wrap (#try.Failure error))))))
)))
+
+(import: java/lang/AutoCloseable
+ (close [] #io #try void))
+
+(import: java/io/OutputStream
+ (flush [] #io #try void)
+ (write [[byte]] #io #try void))
+
+(import: java/lang/String)
+
+(import: 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: java/net/HttpURLConnection
+ (setRequestMethod [java/lang/String] #io #try void)
+ (getResponseCode [] #io #try int))
+
+(import: java/net/URL
+ (new [java/lang/String])
+ (openConnection [] #io #try java/net/URLConnection))
+
+(import: java/util/Base64$Encoder
+ (encodeToString [[byte]] java/lang/String))
+
+(import: 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: (url address artifact extension)
+ (-> Address Artifact Extension URL)
+ (format address uri.separator (//artifact.uri artifact) extension))
+
+(structure: #export (default address)
+ (All [s] (-> Address (Repository IO)))
+
+ (def: (download artifact extension)
+ (io.io (#try.Failure "YOLO")))
+
+ (def: (upload [user password] artifact extension content)
+ (do (try.with io.monad)
+ [connection (|> (..url address artifact extension)
+ 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])))))
+ )
diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux
deleted file mode 100644
index 391413f03..000000000
--- a/stdlib/source/program/aedifex/upload.lux
+++ /dev/null
@@ -1,95 +0,0 @@
-(.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]]]]
- ["." // #_
- ["#." repository (#+ Address User Password)]
- ["#." dependency (#+ Dependency)]
- ["#." artifact]])
-
-(type: #export (Action a)
- (IO (Try a)))
-
-(def: #export monad
- (:coerce (Monad Action)
- (try.with io.monad)))
-
-(def: (url repository dependency)
- (-> Address Dependency URL)
- (format repository
- uri.separator
- (//artifact.uri (get@ #//dependency.artifact dependency))
- "."
- (get@ #//dependency.type dependency)))
-
-(import: java/lang/AutoCloseable
- (close [] #io #try void))
-
-(import: java/io/OutputStream
- (flush [] #io #try void)
- (write [[byte]] #io #try void))
-
-(import: java/lang/String)
-
-(import: 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: java/net/HttpURLConnection
- (setRequestMethod [java/lang/String] #io #try void)
- (getResponseCode [] #io #try int))
-
-(import: java/net/URL
- (new [java/lang/String])
- (openConnection [] #io #try java/net/URLConnection))
-
-(import: java/util/Base64$Encoder
- (encodeToString [[byte]] java/lang/String))
-
-(import: 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)
- (-> Address 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-26 04:03:07 +0000