aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
authorEduardo Julian2020-12-17 22:03:54 -0400
committerEduardo Julian2020-12-17 22:03:54 -0400
commit68b1dd82f23d6648ac3d9075a8f84b0174392945 (patch)
tree2db148a005c21552947d96dfd4e788ba21705037 /stdlib/source/program
parentabc5c5293603229b447b8b5dfa7f3275571ad982 (diff)
More optimizations to the Lux syntax parser.
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex/artifact.lux16
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux118
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux6
-rw-r--r--stdlib/source/program/aedifex/metadata.lux12
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux17
-rw-r--r--stdlib/source/program/aedifex/metadata/snapshot.lux12
-rw-r--r--stdlib/source/program/aedifex/repository.lux104
7 files changed, 197 insertions, 88 deletions
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index a26e70e50..e4fe812f1 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -2,8 +2,9 @@
[lux (#- Name)
[abstract
[equivalence (#+ Equivalence)]
- ["." hash (#+ Hash)]]
+ [hash (#+ Hash)]]
[data
+ ["." product]
["." text
["%" format (#+ Format)]]
[collection
@@ -29,7 +30,7 @@
(def: #export hash
(Hash Artifact)
- ($_ hash.product
+ ($_ product.hash
text.hash
text.hash
text.hash
@@ -61,12 +62,15 @@
..identity-separator
(..identity value)))
+(def: #export (directory separator group)
+ (-> Text Group Text)
+ (|> group
+ (text.split-all-with ..group-separator)
+ (text.join-with separator)))
+
(def: (address separator artifact)
(-> Text Artifact Text)
- (let [directory (%.format (|> artifact
- (get@ #group)
- (text.split-all-with ..group-separator)
- (text.join-with separator))
+ (let [directory (%.format (..directory separator (get@ #group artifact))
separator
(get@ #name artifact)
separator
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index dbe4a88cb..4e33b145a 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -3,11 +3,16 @@
[abstract
[monad (#+ do)]]
[control
+ [pipe (#+ do>)]
+ ["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise) ("#\." monad)]]]
+ ["." promise (#+ Promise) ("#\." monad)]]
+ ["<>" parser
+ ["<.>" xml]]]
[data
[binary (#+ Binary)]
[text
+ ["%" format (#+ format)]
["." encoding]]
[collection
["." set]]
@@ -15,6 +20,8 @@
["." binary]
["." tar]
["." xml]]]
+ [time
+ ["." instant (#+ Instant)]]
[world
["." file]
["." console (#+ Console)]]]
@@ -24,28 +31,107 @@
["." // #_
["#." clean]
["/#" // #_
- [repository (#+ Identity Repository)]
[command (#+ Command)]
["/" profile]
["#." action (#+ Action)]
["#." pom]
["#." hash]
+ ["#." repository (#+ Identity Repository)]
+ ["#." metadata
+ ["#/." artifact]
+ ["#/." snapshot]]
["#." artifact (#+ Artifact)
- ["#/." extension (#+ Extension)]]]])
+ ["#/." extension (#+ Extension)]
+ ["#/." type]]]])
+
+(def: epoch
+ Instant
+ (instant.from-millis +0))
+
+(template [<name> <type> <uri> <parser> <default>]
+ [(def: (<name> repository artifact)
+ (-> (Repository Promise) Artifact (Promise (Try <type>)))
+ (do promise.monad
+ [project (\ repository download (<uri> artifact))]
+ (case project
+ (#try.Success project)
+ (wrap (|> project
+ (do> try.monad
+ [(\ encoding.utf8 decode)]
+ [(\ xml.codec decode)]
+ [(<xml>.run <parser>)])))
+
+ (#try.Failure error)
+ (wrap (#try.Success <default>)))))]
+
+ [read-project-metadata ///metadata/artifact.Metadata ///metadata.project ///metadata/artifact.parser
+ (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ {#///metadata/artifact.group group
+ #///metadata/artifact.name name
+ #///metadata/artifact.versions (list)
+ #///metadata/artifact.last-updated ..epoch})]
+ [read-version-metadata ///metadata/snapshot.Metadata ///metadata.version ///metadata/snapshot.parser
+ (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ {#///metadata/snapshot.group group
+ #///metadata/snapshot.name name
+ #///metadata/snapshot.version version
+ #///metadata/snapshot.versioning {#///metadata/snapshot.time-stamp ..epoch
+ #///metadata/snapshot.build 0
+ #///metadata/snapshot.snapshot (list)}})]
+ )
+
+(def: snapshot-artifacts
+ (List ///artifact/type.Type)
+ (list ///artifact/type.pom
+ (format ///artifact/type.pom ///artifact/extension.sha-1)
+ (format ///artifact/type.pom ///artifact/extension.md5)
+ ///artifact/type.lux-library
+ (format ///artifact/type.lux-library ///artifact/extension.sha-1)
+ (format ///artifact/type.lux-library ///artifact/extension.md5)))
(def: #export (do! console repository fs identity artifact profile)
(-> (Console Promise) (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)))]
- (console.write-line //clean.success console))))
+ (|>> (///repository.uri artifact)
+ (\ repository upload identity)))
+ fully-deploy! (: (-> Extension Binary (Action Any))
+ (function (_ extension payload)
+ (do ///action.monad
+ [_ (deploy! extension payload)
+ _ (deploy! (format extension ///artifact/extension.sha-1)
+ (///hash.data (///hash.sha-1 payload)))
+ _ (deploy! (format extension ///artifact/extension.md5)
+ (///hash.data (///hash.md5 payload)))]
+ (wrap []))))
+ (^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+ (do promise.monad
+ [now (promise.future instant.now)]
+ (do {! ///action.monad}
+ [project (..read-project-metadata repository artifact)
+ snapshot (..read-version-metadata repository artifact)
+ pom (\ ! map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))
+ (promise\wrap (///pom.write profile)))
+ library (|> profile
+ (get@ #/.sources)
+ set.to-list
+ (export.library fs)
+ (\ ! map (binary.run tar.writer)))
+
+ _ (fully-deploy! ///artifact/extension.pom pom)
+ _ (fully-deploy! ///artifact/extension.lux-library library)
+ _ (|> snapshot
+ (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.time-stamp] now)
+ (update@ [#///metadata/snapshot.versioning #///metadata/snapshot.build] inc)
+ (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.snapshot] ..snapshot-artifacts)
+ ///metadata/snapshot.write
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode)
+ (\ repository upload identity (///metadata.version artifact)))
+ _ (|> project
+ (set@ #///metadata/artifact.versions (list version))
+ (set@ #///metadata/artifact.last-updated now)
+ ///metadata/artifact.write
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode)
+ (\ repository upload identity (///metadata.project artifact)))]
+ (console.write-line //clean.success console)))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index e8b0f2dba..2131495b9 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -58,7 +58,7 @@
(Exception [Dependency Text])
(Promise (Try (///hash.Hash h)))))
(do (try.with promise.monad)
- [actual (\ repository download artifact extension)]
+ [actual (\ repository download (///repository.uri artifact extension))]
(\ promise.monad wrap
(do try.monad
[output (\ encoding.utf8 decode actual)
@@ -72,14 +72,14 @@
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
- [library (\ repository download artifact extension)
+ [library (\ repository download (///repository.uri artifact extension))
sha-1 (..verified-hash dependency library
repository artifact ///artifact/extension.sha-1
///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
md5 (..verified-hash dependency library
repository artifact ///artifact/extension.md5
///hash.md5 ///hash.md5-codec ..md5-does-not-match)
- pom (\ repository download artifact ///artifact/extension.pom)]
+ pom (\ repository download (///repository.uri artifact ///artifact/extension.pom))]
(\ promise.monad wrap
(do try.monad
[pom (\ encoding.utf8 decode pom)
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux
index 937fea4a3..11a792528 100644
--- a/stdlib/source/program/aedifex/metadata.lux
+++ b/stdlib/source/program/aedifex/metadata.lux
@@ -7,22 +7,22 @@
[file (#+ Path)]
[net
["." uri (#+ URI)]]]]
- ["." //
+ [//
["." artifact (#+ Artifact)]])
(def: #export file
Path
"maven-metadata.xml")
-(def: (project separator artifact)
+(def: (project' separator artifact)
(-> Text Artifact Text)
(format (artifact.directory separator (get@ #artifact.group artifact))
separator
(get@ #artifact.name artifact)))
-(def: (version separator artifact)
+(def: (version' separator artifact)
(-> Text Artifact Text)
- (format (..project separator artifact)
+ (format (..project' separator artifact)
separator
(get@ #artifact.version artifact)))
@@ -32,6 +32,6 @@
(let [/ uri.separator]
(format (<private> / artifact) / ..file)))]
- [for-project ..project]
- [for-version ..version]
+ [project ..project']
+ [version ..version']
)
diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux
index 1f8068111..aa7b9abce 100644
--- a/stdlib/source/program/aedifex/metadata/artifact.lux
+++ b/stdlib/source/program/aedifex/metadata/artifact.lux
@@ -61,6 +61,7 @@
[<group> "groupId"]
[<name> "artifactId"]
[<version> "version"]
+ [<versioning> "versioning"]
[<versions> "versions"]
[<last-updated> "lastUpdated"]
[<metadata> "metadata"]
@@ -87,8 +88,10 @@
xml.attributes
(list (..write-group (get@ #group value))
(..write-name (get@ #name value))
- (..write-versions (get@ #versions value))
- (..write-last-updated (get@ #last-updated value)))))
+ (#xml.Node ..<versioning>
+ xml.attributes
+ (list (..write-versions (get@ #versions value))
+ (..write-last-updated (get@ #last-updated value)))))))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -136,9 +139,13 @@
($_ <>.and
(<xml>.somewhere (..text ..<group>))
(<xml>.somewhere (..text ..<name>))
- (<xml>.somewhere (<| (..sub ..<versions>)
- (<>.many (..text ..<version>))))
- (<xml>.somewhere ..last-updated-parser)
+ (<| (..sub ..<versioning>)
+ ($_ <>.and
+ (<| <xml>.somewhere
+ (..sub ..<versions>)
+ (<>.many (..text ..<version>)))
+ (<xml>.somewhere ..last-updated-parser)
+ ))
)))
(def: #export equivalence
diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux
index a94ac33c4..1919d06ca 100644
--- a/stdlib/source/program/aedifex/metadata/snapshot.lux
+++ b/stdlib/source/program/aedifex/metadata/snapshot.lux
@@ -212,7 +212,7 @@
(Parser Build)
(<text>.embed (<>.codec n.decimal
(<text>.many <text>.decimal))
- (..text ..<timestamp>)))
+ (..text ..<build-number>)))
(exception: #export (time-stamp-mismatch {expected Time-Stamp} {actual Text})
(exception.report
@@ -226,7 +226,7 @@
(def: (snapshot-parser expected)
(-> Value (Parser Type))
- (<| (..sub ..<snapshot-versions>)
+ (<| (..sub ..<snapshot-version>)
(do <>.monad
[#let [[version time-stamp build] expected]
updated (<xml>.somewhere (..text ..<updated>))
@@ -243,8 +243,8 @@
(do <>.monad
[[time-stamp build] (<| <xml>.somewhere
(..sub ..<snapshot>)
- (<>.and ..time-stamp-parser
- ..build-parser))
+ (<>.and (<xml>.somewhere ..time-stamp-parser)
+ (<xml>.somewhere ..build-parser)))
last-updated (<xml>.somewhere ..last-updated-parser)
_ (<>.assert (exception.construct ..time-stamp-mismatch [time-stamp (instant-format last-updated)])
(\ instant.equivalence = time-stamp last-updated))
@@ -268,7 +268,7 @@
#version version
#versioning versioning}))))
-(def: versioning
+(def: versioning-equivalence
(Equivalence Versioning)
($_ product.equivalence
instant.equivalence
@@ -282,5 +282,5 @@
text.equivalence
text.equivalence
text.equivalence
- ..versioning
+ ..versioning-equivalence
))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index 7ec522a10..c351e9d0c 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -17,9 +17,15 @@
["." encoding]]
[number
["n" nat]]]
+ [tool
+ [compiler
+ ["." version]
+ ["." language #_
+ ["#/." lux #_
+ ["#" version]]]]]
[world
[net (#+ URL)
- ["." uri]]]]
+ ["." uri (#+ URI)]]]]
["." // #_
["#." artifact (#+ Artifact)
["#/." extension (#+ Extension)]]])
@@ -38,38 +44,36 @@
#password Password})
(signature: #export (Repository !)
- (: (-> Artifact Extension (! (Try Binary)))
+ (: (-> URI (! (Try Binary)))
download)
- (: (-> Identity Artifact Extension Binary (! (Try Any)))
+ (: (-> Identity URI Binary (! (Try Any)))
upload))
(def: #export (async repository)
(-> (Repository IO) (Repository Promise))
(structure
- (def: (download artifact extension)
- (promise.future (\ repository download artifact extension)))
+ (def: (download uri)
+ (promise.future (\ repository download uri)))
- (def: (upload identity artifact extension content)
- (promise.future (\ repository upload identity artifact extension content)))
+ (def: (upload identity uri content)
+ (promise.future (\ repository upload identity uri content)))
))
(signature: #export (Simulation s)
- (: (-> Artifact Extension s
- (Try [s Binary]))
+ (: (-> URI s (Try [s Binary]))
on-download)
- (: (-> Identity Artifact Extension Binary s
- (Try s))
+ (: (-> Identity URI Binary s (Try s))
on-upload))
(def: #export (mock simulation init)
(All [s] (-> (Simulation s) s (Repository Promise)))
(let [state (stm.var init)]
(structure
- (def: (download artifact extension)
+ (def: (download uri)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on-download artifact extension |state|)
+ (case (\ simulation on-download uri |state|)
(#try.Success [|state| output])
(do !
[_ (stm.write |state| state)]
@@ -78,11 +82,11 @@
(#try.Failure error)
(wrap (#try.Failure error))))))
- (def: (upload identity artifact extension content)
+ (def: (upload identity uri content)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on-upload identity artifact extension content |state|)
+ (case (\ simulation on-upload identity uri content |state|)
(#try.Success |state|)
(do !
[_ (stm.write |state| state)]
@@ -98,6 +102,8 @@
["#::."
(close [] #io #try void)])
+(import: java/io/InputStream)
+
(import: java/io/OutputStream
["#::."
(flush [] #io #try void)
@@ -107,6 +113,7 @@
["#::."
(setDoOutput [boolean] #io #try void)
(setRequestProperty [java/lang/String java/lang/String] #io #try void)
+ (getInputStream [] #io #try java/io/InputStream)
(getOutputStream [] #io #try java/io/OutputStream)])
(import: java/net/HttpURLConnection
@@ -117,8 +124,7 @@
(import: java/net/URL
["#::."
(new [java/lang/String])
- (openConnection [] #io #try java/net/URLConnection)
- (openStream [] #io #try java/io/InputStream)])
+ (openConnection [] #io #try java/net/URLConnection)])
(import: java/util/Base64$Encoder
["#::."
@@ -128,8 +134,6 @@
["#::."
(#static getEncoder [] java/util/Base64$Encoder)])
-(import: java/io/InputStream)
-
(import: java/io/BufferedInputStream
["#::."
(new [java/io/InputStream])
@@ -141,42 +145,50 @@
(def: (basic-auth user password)
(-> User Password Text)
- (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password))
+ (format "Basic " (java/util/Base64$Encoder::encodeToString (\ encoding.utf8 encode (format user ":" password))
(java/util/Base64::getEncoder))))
-(def: (url address artifact extension)
- (-> Address Artifact Extension URL)
- (format address uri.separator (//artifact.uri artifact) extension))
+(def: #export (uri artifact extension)
+ (-> Artifact Extension URI)
+ (format (//artifact.uri artifact) extension))
(def: buffer-size
(n.* 512 1,024))
+(def: user-agent
+ (format "LuxAedifex/" (version.format language/lux.version)))
+
(structure: #export (remote address)
(All [s] (-> Address (Repository IO)))
- (def: (download artifact extension)
- (let [url (..url address artifact extension)]
- (do {! (try.with io.monad)}
- [input (|> (java/net/URL::new url)
- java/net/URL::openStream
- (\ ! map (|>> java/io/BufferedInputStream::new)))
- #let [buffer (binary.create ..buffer-size)]]
- (loop [output (\ binary.monoid identity)]
- (do !
- [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
- (case bytes-read
- -1 (do !
- [_ (java/lang/AutoCloseable::close input)]
- (wrap output))
- _ (if (n.= ..buffer-size bytes-read)
- (recur (\ binary.monoid compose output buffer))
- (do !
- [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
- (recur (\ binary.monoid compose output chunk))))))))))
-
- (def: (upload [user password] artifact extension content)
+ (def: (download uri)
+ (do {! (try.with io.monad)}
+ [connection (|> (format address uri)
+ java/net/URL::new
+ java/net/URL::openConnection)
+ #let [connection (:coerce java/net/HttpURLConnection connection)]
+ _ (java/net/HttpURLConnection::setRequestMethod "GET" connection)
+ _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user-agent connection)
+ input (|> connection
+ java/net/URLConnection::getInputStream
+ (\ ! map (|>> java/io/BufferedInputStream::new)))
+ #let [buffer (binary.create ..buffer-size)]]
+ (loop [output (\ binary.monoid identity)]
+ (do !
+ [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
+ (case bytes-read
+ -1 (do !
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ _ (if (n.= ..buffer-size bytes-read)
+ (recur (\ binary.monoid compose output buffer))
+ (do !
+ [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
+ (recur (\ binary.monoid compose output chunk)))))))))
+
+ (def: (upload [user password] uri content)
(do (try.with io.monad)
- [connection (|> (..url address artifact extension)
+ [connection (|> (format address uri)
java/net/URL::new
java/net/URL::openConnection)
#let [connection (:coerce java/net/HttpURLConnection connection)]
@@ -189,6 +201,6 @@
_ (java/lang/AutoCloseable::close stream)
code (java/net/HttpURLConnection::getResponseCode connection)]
(case code
- +200 (wrap [])
+ +201 (wrap [])
_ (\ io.monad wrap (exception.throw ..deployment-failure [code])))))
)