From 2e5852abb1ac0ae5abdd8709238aca447f62520e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Nov 2020 00:29:40 -0400 Subject: Pure-Lux implementation for biggest and smallest Frac values. --- stdlib/source/program/aedifex/cli.lux | 11 ++- stdlib/source/program/aedifex/command/deploy.lux | 72 ++++++------------ stdlib/source/program/aedifex/dependency.lux | 22 +++--- stdlib/source/program/aedifex/repository.lux | 76 ++++++++++++++++++- stdlib/source/program/aedifex/upload.lux | 95 ------------------------ 5 files changed, 110 insertions(+), 166 deletions(-) delete mode 100644 stdlib/source/program/aedifex/upload.lux (limited to 'stdlib/source/program/aedifex') 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]))))) -- cgit v1.2.3