aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex/artifact.lux6
-rw-r--r--stdlib/source/program/aedifex/artifact/versioning.lux7
-rw-r--r--stdlib/source/program/aedifex/command/build.lux2
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux17
-rw-r--r--stdlib/source/program/aedifex/command/deps.lux42
-rw-r--r--stdlib/source/program/aedifex/command/install.lux20
-rw-r--r--stdlib/source/program/aedifex/dependency/deployment.lux51
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux137
-rw-r--r--stdlib/source/program/aedifex/local.lux9
-rw-r--r--stdlib/source/program/aedifex/metadata.lux6
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux4
-rw-r--r--stdlib/source/program/aedifex/metadata/snapshot.lux241
-rw-r--r--stdlib/source/program/aedifex/package.lux27
-rw-r--r--stdlib/source/program/aedifex/parser.lux6
-rw-r--r--stdlib/source/program/aedifex/pom.lux42
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux22
-rw-r--r--stdlib/source/program/aedifex/repository/remote.lux34
17 files changed, 321 insertions, 352 deletions
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index 07b53157f..9e87988ea 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -68,12 +68,12 @@
(text.split_all_with ..group_separator)
(text.join_with separator)))
-(def: #export (uri artifact)
- (-> Artifact URI)
+(def: #export (uri version artifact)
+ (-> Version Artifact URI)
(let [/ uri.separator
group (..directory / (get@ #group artifact))
name (get@ #name artifact)
- version (get@ #version artifact)
+ ## version (get@ #version artifact)
identity (..identity artifact)]
(%.format group / name / version / identity)))
diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux
index 41b3179d3..dab943145 100644
--- a/stdlib/source/program/aedifex/artifact/versioning.lux
+++ b/stdlib/source/program/aedifex/artifact/versioning.lux
@@ -89,9 +89,10 @@
(Parser Versioning)
(<| (..sub ..<versioning>)
($_ <>.and
- (<xml>.somewhere //snapshot.parser)
- (<xml>.somewhere ..last_updated_parser)
- (<| <xml>.somewhere
+ (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser))
+ (<>.default instant.epoch (<xml>.somewhere ..last_updated_parser))
+ (<| (<>.default (list))
+ <xml>.somewhere
(..sub ..<snapshot_versions>)
(<>.some //snapshot/version.parser))
)))
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 7241b1de4..388a48c89 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -107,7 +107,7 @@
(All [!] (-> (file.System !) Path Artifact Path))
(let [/ (\ fs separator)]
(|> artifact
- ///local.uri
+ (///local.uri (get@ #///artifact.version artifact))
(text.replace_all uri.separator /)
(format home /))))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index fe96055ef..758f87ab9 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -63,12 +63,13 @@
_ (///dependency/deployment.one
repository
[artifact ///artifact/type.lux_library]
- {#///package.origin (#///repository/origin.Remote "")
- #///package.library [library
- (///dependency/status.verified library)]
- #///package.pom [pom
- (|> pom
- (\ xml.codec encode)
- (\ encoding.utf8 encode)
- ///dependency/status.verified)]})]
+ (let [pom_data (|> pom
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode))]
+ {#///package.origin (#///repository/origin.Remote "")
+ #///package.library [library
+ (///dependency/status.verified library)]
+ #///package.pom [pom
+ pom_data
+ (///dependency/status.verified pom_data)]}))]
(console.write_line //clean.success console)))
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
index 71dffeec1..14b5d803f 100644
--- a/stdlib/source/program/aedifex/command/deps.lux
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -3,13 +3,16 @@
[abstract
[monad (#+ do)]]
[control
+ ["." exception]
[concurrency
["." promise (#+ Promise)]]]
[data
[collection
["." set (#+ Set)]
["." list ("#\." fold)]
- ["." dictionary]]]
+ ["." dictionary]]
+ [text
+ ["%" format (#+ format)]]]
[world
[program (#+ Program)]
["." file]
@@ -18,22 +21,39 @@
["#." clean]
["/#" // #_
[command (#+ Command)]
- [artifact (#+ Artifact)]
[repository (#+ Repository)]
["#" profile]
["#." action (#+ Action)]
- ["#." dependency #_
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency (#+ Dependency)
["#/." resolution (#+ Resolution)]
["#/." deployment]]]])
+(def: %dependency
+ (%.Format Dependency)
+ (|>> (get@ #///dependency.artifact)
+ ///artifact.format
+ %.text))
+
(def: #export (do! console local remotes profile)
(-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution))
- (do ///action.monad
+ (do promise.monad
[#let [dependencies (set.to_list (get@ #///.dependencies profile))]
- cache (///dependency/resolution.all (list local) dependencies ///dependency/resolution.empty)
- resolution (///dependency/resolution.all remotes dependencies cache)
- cached (|> (dictionary.keys cache)
- (list\fold dictionary.remove resolution)
- (///dependency/deployment.all local))
- _ (console.write_line //clean.success console)]
- (wrap resolution)))
+ [local_successes local_failures cache] (///dependency/resolution.all (list local) dependencies ///dependency/resolution.empty)
+ [remote_successes remote_failures resolution] (///dependency/resolution.all remotes dependencies cache)]
+ (do ///action.monad
+ [cached (|> (dictionary.keys cache)
+ (list\fold dictionary.remove resolution)
+ (///dependency/deployment.all local))
+ _ (console.write_line //clean.success console)
+ _ (console.write_line (exception.report
+ ["Local successes" (exception.enumerate %dependency local_successes)]
+ ["Local failures" (exception.enumerate %dependency local_failures)]
+ ["Remote successes" (let [remote_successes (|> remote_successes
+ (set.from_list ///dependency.hash)
+ (set.difference (set.from_list ///dependency.hash local_successes))
+ set.to_list)]
+ (exception.enumerate %dependency remote_successes))]
+ ["Remote failures" (exception.enumerate %dependency remote_failures)])
+ console)]
+ (wrap resolution))))
diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux
index b051a4900..35ffcf72f 100644
--- a/stdlib/source/program/aedifex/command/install.lux
+++ b/stdlib/source/program/aedifex/command/install.lux
@@ -54,15 +54,17 @@
(do ///action.monad
[package (export.library system (set.to_list (get@ #/.sources profile)))
pom (\ promise.monad wrap (///pom.write profile))
- _ (///dependency/deployment.one repository [identity ///artifact/type.lux_library]
- {#///package.origin (#///origin.Local "")
- #///package.library (let [library (binary.run tar.writer package)]
- [library (///dependency/status.verified library)])
- #///package.pom [pom
- (|> pom
- (\ xml.codec encode)
- (\ encoding.utf8 encode)
- ///dependency/status.verified)]})]
+ _ (///dependency/deployment.one repository
+ [identity ///artifact/type.lux_library]
+ (let [pom_data (|> pom
+ (\ xml.codec encode)
+ (\ encoding.utf8 encode))]
+ {#///package.origin (#///origin.Local "")
+ #///package.library (let [library (binary.run tar.writer package)]
+ [library (///dependency/status.verified library)])
+ #///package.pom [pom
+ pom_data
+ (///dependency/status.verified pom_data)]}))]
(console.write_line //clean.success console))
_
diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux
index 1f3e776a9..04b82d7e2 100644
--- a/stdlib/source/program/aedifex/dependency/deployment.lux
+++ b/stdlib/source/program/aedifex/dependency/deployment.lux
@@ -32,7 +32,11 @@
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." type]
- ["#/." extension (#+ Extension)]]
+ ["#/." extension (#+ Extension)]
+ ["#/." versioning]
+ ["#/." snapshot
+ ["#/." version (#+ Version)
+ ["#/." value]]]]
["#." metadata
["#/." artifact]
["#/." snapshot]]
@@ -42,9 +46,9 @@
["#." repository (#+ Repository)
["#/." origin]]])
-(def: (with_status repository [artifact type] [data status])
- (-> (Repository Promise) Dependency [Binary Status] (Promise (Try Any)))
- (let [artifact (format (///artifact.uri artifact)
+(def: (with_status repository version_template [artifact type] [data status])
+ (-> (Repository Promise) ///artifact.Version Dependency [Binary Status] (Promise (Try Any)))
+ (let [artifact (format (///artifact.uri version_template artifact)
(///artifact/extension.extension type))
deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
(function (_ codec extension hash)
@@ -91,29 +95,44 @@
(def: #export (one repository [artifact type] package)
(-> (Repository Promise) Dependency Package (Promise (Try Artifact)))
(do {! promise.monad}
- [now (promise.future instant.now)]
+ [now (promise.future instant.now)
+ #let [version_template (get@ #///artifact.version artifact)]]
(do (try.with !)
- [_ (with_status repository [artifact type] (get@ #///package.library package))
+ [_ (with_status repository version_template [artifact type] (get@ #///package.library package))
- _ (let [[pom status] (get@ #///package.pom package)]
+ _ (let [[pom pom_data status] (get@ #///package.pom package)]
(with_status repository
+ version_template
[artifact ///artifact/type.pom]
- [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ [pom_data
status]))
snapshot (///metadata/snapshot.read repository artifact)
+ #let [snapshot (|> snapshot
+ (update@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot]
+ (function (_ snapshot)
+ (case snapshot
+ #///artifact/snapshot.Local
+ #///artifact/snapshot.Local
+
+ (#///artifact/snapshot.Remote [_ build])
+ (#///artifact/snapshot.Remote [now (inc build)]))))
+ (set@ [#///metadata/snapshot.versioning #///artifact/versioning.last_updated] now))
+ versioning_snapshot (get@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] snapshot)]
_ (|> 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]
- (list\compose (..artifacts type (product.right (get@ #///package.library package)))
- (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package)))))
+ (set@ [#///metadata/snapshot.versioning #///artifact/versioning.versions]
+ (list {#///artifact/snapshot/version.extension type
+ #///artifact/snapshot/version.value (///artifact/snapshot/version/value.format
+ {#///artifact/snapshot/version/value.version version_template
+ #///artifact/snapshot/version/value.snapshot versioning_snapshot})
+ #///artifact/snapshot/version.updated now}))
+ ## (set@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot]
+ ## (list\compose (..artifacts type (product.right (get@ #///package.library package)))
+ ## (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package)))))
(///metadata/snapshot.write repository artifact))
-
project (///metadata/artifact.read repository artifact)
- #let [version (get@ #///artifact.version artifact)]
_ (|> project
- (set@ #///metadata/artifact.versions (list version))
+ (set@ #///metadata/artifact.versions (list version_template))
(set@ #///metadata/artifact.last_updated now)
(///metadata/artifact.write repository artifact))]
(wrap artifact))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index e6b24b152..1be540298 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -1,12 +1,13 @@
(.module:
[lux (#- Name)
+ ["." debug]
["." host (#+ import:)]
[abstract
[codec (#+ Codec)]
[equivalence (#+ Equivalence)]
[monad (#+ Monad do)]]
[control
- ["." try (#+ Try)]
+ ["." try (#+ Try) ("#\." functor)]
["." exception (#+ Exception exception:)]
["<>" parser
["<.>" xml (#+ Parser)]]
@@ -16,14 +17,15 @@
["." binary (#+ Binary)]
["." name]
["." maybe]
- [text
+ ["." text
["%" format (#+ format)]
["." encoding]]
[format
["." xml (#+ Tag XML)]]
[collection
["." dictionary (#+ Dictionary)]
- ["." set]]]
+ ["." set]
+ ["." list ("#\." functor monoid)]]]
[math
[number
["n" nat]
@@ -38,11 +40,17 @@
["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]
["#." package (#+ Package)]
- ["#." artifact (#+ Artifact)
- ["#/." extension (#+ Extension)]]
+ ["#." artifact (#+ Version Artifact)
+ ["#/." extension (#+ Extension)]
+ ["#/." versioning]
+ ["." snapshot
+ [version
+ ["." value]]]]
["#." repository (#+ Repository)
["#/." remote (#+ Address)]
- ["#/." origin (#+ Origin)]]]])
+ ["#/." origin (#+ Origin)]]
+ ["#." metadata
+ ["#/." snapshot]]]])
(template [<name>]
[(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
@@ -55,19 +63,30 @@
[md5_does_not_match]
)
-(def: (verified_hash library repository artifact extension hash codec exception)
+(import: java/lang/String
+ ["#::."
+ (trim [] java/lang/String)])
+
+(def: (verified_hash library repository version_template artifact extension hash codec exception)
(All [h]
- (-> Binary (Repository Promise) Artifact Extension
+ (-> Binary (Repository Promise) Version Artifact Extension
(-> Binary (Hash h)) (Codec Text (Hash h))
(Exception [Artifact Extension Text])
(Promise (Try (Maybe (Hash h))))))
(do promise.monad
- [?actual (\ repository download (///repository/remote.uri artifact extension))]
+ [?actual (\ repository download (///repository/remote.uri version_template artifact extension))]
(case ?actual
(#try.Success actual)
- (wrap (do try.monad
- [output (\ encoding.utf8 decode actual)
- actual (\ codec decode output)
+ (wrap (do {! try.monad}
+ [output (\ ! map (|>> (:coerce java/lang/String)
+ java/lang/String::trim
+ (:coerce Text))
+ (\ encoding.utf8 decode actual))
+ actual (|> output
+ (text.split_all_with " ")
+ list.head
+ (maybe.default output)
+ (\ codec decode))
_ (exception.assert exception [artifact extension output]
(\ ///hash.equivalence = (hash library) actual))]
(wrap (#.Some actual))))
@@ -75,15 +94,15 @@
(#try.Failure error)
(wrap (#try.Success #.None)))))
-(def: (hashed repository artifact extension)
- (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
+(def: (hashed repository version_template artifact extension)
+ (-> (Repository Promise) Version Artifact Extension (Promise (Try [Binary Status])))
(do (try.with promise.monad)
- [data (\ repository download (///repository/remote.uri artifact extension))
+ [data (\ repository download (///repository/remote.uri version_template artifact extension))
?sha-1 (..verified_hash data
- repository artifact (format extension ///artifact/extension.sha-1)
+ repository version_template artifact (format extension ///artifact/extension.sha-1)
///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match)
?md5 (..verified_hash data
- repository artifact (format extension ///artifact/extension.md5)
+ repository version_template artifact (format extension ///artifact/extension.md5)
///hash.md5 ///hash.md5_codec ..md5_does_not_match)]
(wrap [data (case [?sha-1 ?md5]
[(#.Some sha-1) (#.Some md5)]
@@ -103,16 +122,21 @@
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
- [[pom pom_status] (..hashed repository artifact ///artifact/extension.pom)
- library_&_status (..hashed repository artifact extension)]
+ [snapshot (///metadata/snapshot.read repository artifact)
+ #let [version_template (get@ [#///metadata/snapshot.artifact #///artifact.version] snapshot)
+ artifact_version (value.format {#value.version version_template
+ #value.snapshot (get@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] snapshot)})
+ artifact (set@ #///artifact.version artifact_version artifact)]
+ [pom_data pom_status] (..hashed repository version_template artifact ///artifact/extension.pom)
+ library_&_status (..hashed repository version_template artifact extension)]
(\ promise.monad wrap
(do try.monad
- [pom (\ encoding.utf8 decode pom)
+ [pom (\ encoding.utf8 decode pom_data)
pom (\ xml.codec decode pom)
- profile (<xml>.run ///pom.parser pom)]
+ profile (<xml>.run ///pom.parser (list pom))]
(wrap {#///package.origin (#///repository/origin.Remote "")
#///package.library library_&_status
- #///package.pom [pom pom_status]}))))))
+ #///package.pom [pom pom_data pom_status]}))))))
(type: #export Resolution
(Dictionary Dependency Package))
@@ -149,21 +173,54 @@
(any alternatives dependency)))))
(def: #export (all repositories dependencies resolution)
- (-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution)))
- (case dependencies
- #.Nil
- (\ (try.with promise.monad) wrap resolution)
-
- (#.Cons head tail)
- (do (try.with promise.monad)
- [package (case (dictionary.get head resolution)
- (#.Some package)
- (wrap package)
-
- #.None
- (..any repositories head))
- sub_dependencies (\ promise.monad wrap (///package.dependencies package))
- resolution (|> resolution
- (dictionary.put head package)
- (all repositories (set.to_list sub_dependencies)))]
- (all repositories tail resolution))))
+ (-> (List (Repository Promise)) (List Dependency) Resolution
+ (Promise [(List Dependency)
+ (List Dependency)
+ Resolution]))
+ (loop [repositories repositories
+ successes (: (List Dependency) (list))
+ failures (: (List Dependency) (list))
+ dependencies dependencies
+ resolution resolution]
+ (case dependencies
+ #.Nil
+ (\ promise.monad wrap
+ [successes failures resolution])
+
+ (#.Cons head tail)
+ (case (get@ [#//.artifact #///artifact.version] head)
+ ## Skip if there is no version
+ "" (recur repositories
+ successes
+ failures
+ tail
+ resolution)
+ _ (do promise.monad
+ [?package (case (dictionary.get head resolution)
+ (#.Some package)
+ (wrap (#try.Success package))
+
+ #.None
+ (..any repositories head))]
+ (case ?package
+ (#try.Success package)
+ (let [sub_dependencies (|> package
+ ///package.dependencies
+ (try\map set.to_list)
+ (try.default (list)))
+ sub_repositories (|> package
+ ///package.repositories
+ (try\map set.to_list)
+ (try.default (list))
+ (list\map (|>> (///repository/remote.repository #.None)
+ ///repository.async))
+ (list\compose repositories))]
+ (|> resolution
+ (dictionary.put head package)
+ (recur sub_repositories
+ (#.Cons head successes)
+ failures
+ sub_dependencies)))
+
+ (#try.Failure error)
+ (wrap [successes (#.Cons head failures) resolution])))))))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 279973c1a..bf8c0f780 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -7,7 +7,7 @@
[net
["." uri (#+ URI)]]]]
["." // #_
- ["#." artifact (#+ Artifact)]])
+ ["#." artifact (#+ Version Artifact)]])
(def: / uri.separator)
@@ -15,7 +15,6 @@
URI
(format ".m2" / "repository"))
-(def: #export uri
- (-> Artifact URI)
- (|>> //artifact.uri
- (format ..repository /)))
+(def: #export (uri version artifact)
+ (-> Version Artifact URI)
+ (format ..repository / (//artifact.uri version artifact)))
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux
index 0eca976c0..08dab9ed3 100644
--- a/stdlib/source/program/aedifex/metadata.lux
+++ b/stdlib/source/program/aedifex/metadata.lux
@@ -3,6 +3,10 @@
[world
[file (#+ Path)]]])
-(def: #export file
+(def: #export remote_file
Path
"maven-metadata.xml")
+
+(def: #export local_file
+ Path
+ "maven-metadata-local.xml")
diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux
index c1d98a8b5..811713427 100644
--- a/stdlib/source/program/aedifex/metadata/artifact.lux
+++ b/stdlib/source/program/aedifex/metadata/artifact.lux
@@ -173,7 +173,7 @@
(let [/ uri.separator
group (///artifact.directory / (get@ #///artifact.group artifact))
name (get@ #///artifact.name artifact)]
- (%.format group / name / //.file)))
+ (%.format group / name / //.remote_file)))
(def: epoch
Instant
@@ -189,7 +189,7 @@
(do> try.monad
[(\ encoding.utf8 decode)]
[(\ xml.codec decode)]
- [(<xml>.run ..parser)])))
+ [list (<xml>.run ..parser)])))
(#try.Failure error)
(wrap (#try.Success
diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux
index 99ad25470..fa1bcb750 100644
--- a/stdlib/source/program/aedifex/metadata/snapshot.lux
+++ b/stdlib/source/program/aedifex/metadata/snapshot.lux
@@ -4,7 +4,7 @@
[monad (#+ do)]
[equivalence (#+ Equivalence)]]
[control
- [pipe (#+ do>)]
+ [pipe (#+ do> case>)]
["." try (#+ Try)]
["." exception (#+ exception:)]
["<>" parser
@@ -33,96 +33,25 @@
[net
["." uri (#+ URI)]]]]
["." //
- ["." artifact]
["/#" // #_
[repository (#+ Repository)]
["#." artifact (#+ Group Name Version Artifact)
- ["#/." type (#+ Type)]]]])
-
-(def: snapshot
- "SNAPSHOT")
-
-(type: #export Time_Stamp
- Instant)
-
-(type: #export Build
- Nat)
-
-(type: #export Versioning
- {#time_stamp Time_Stamp
- #build Build
- #snapshot (List Type)})
-
-(type: #export Value
- [Version Time_Stamp Build])
+ ["#/." type (#+ Type)]
+ ["#/." versioning (#+ Versioning)]
+ ["#/." snapshot
+ ["#/." version]]]]])
(type: #export Metadata
{#artifact Artifact
#versioning Versioning})
-(def: (pad value)
- (-> Nat Text)
- (if (n.< 10 value)
- (%.format "0" (%.nat value))
- (%.nat value)))
-
-(def: (date_format value)
- (%.Format Date)
- (%.format (|> value date.year year.value .nat %.nat)
- (|> value date.month month.number ..pad)
- (|> value date.day_of_month ..pad)))
-
-(def: (time_format value)
- (%.Format Time)
- (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)]
- (%.format (..pad hour)
- (..pad minute)
- (..pad second))))
-
-(def: (instant_format value)
- (%.Format Instant)
- (%.format (..date_format (instant.date value))
- (..time_format (instant.time value))))
-
-(template [<separator> <name>]
- [(def: <name>
- <separator>)]
-
- ["." time_stamp_separator]
- ["-" value_separator]
- )
-
-(def: (time_stamp_format value)
- (%.Format Time_Stamp)
- (%.format (..date_format (instant.date value))
- ..time_stamp_separator
- (..time_format (instant.time value))))
-
-(def: (value_format [version time_stamp build])
- (%.Format Value)
- (%.format (text.replace_all ..snapshot
- (..time_stamp_format time_stamp)
- version)
- ..value_separator
- (%.nat build)))
-
(template [<definition> <tag>]
[(def: <definition> xml.Tag ["" <tag>])]
[<group> "groupId"]
[<name> "artifactId"]
[<version> "version"]
- [<last_updated> "lastUpdated"]
[<metadata> "metadata"]
- [<versioning> "versioning"]
- [<snapshot> "snapshot"]
- [<timestamp> "timestamp"]
- [<build_number> "buildNumber"]
- [<snapshot_versions> "snapshotVersions"]
- [<snapshot_version> "snapshotVersion"]
- [<extension> "extension"]
- [<value> "value"]
- [<updated> "updated"]
)
(template [<name> <type> <tag> <pre>]
@@ -133,33 +62,8 @@
[format_group Group ..<group> (|>)]
[format_name Name ..<name> (|>)]
[format_version Version ..<version> (|>)]
- [format_last_updated Instant ..<last_updated> ..instant_format]
- [format_time_stamp Instant ..<timestamp> ..time_stamp_format]
- [format_build_number Nat ..<build_number> %.nat]
- [format_extension Type ..<extension> (|>)]
- [format_value Value ..<value> ..value_format]
- [format_updated Instant ..<updated> ..instant_format]
)
-(def: (format_snapshot value type)
- (-> Value Type XML)
- (<| (#xml.Node ..<snapshot_version> xml.attributes)
- (list (..format_extension type)
- (..format_value value)
- (let [[version time_stamp build] value]
- (..format_updated time_stamp)))))
-
-(def: (format_versioning version (^slots [#time_stamp #build #snapshot]))
- (-> Version Versioning XML)
- (<| (#xml.Node ..<versioning> xml.attributes)
- (list (<| (#xml.Node ..<snapshot> xml.attributes)
- (list (..format_time_stamp time_stamp)
- (..format_build_number build)))
- (..format_last_updated time_stamp)
- (<| (#xml.Node ..<snapshot_versions> xml.attributes)
- (list\map (..format_snapshot [version time_stamp build])
- snapshot)))))
-
(def: #export (format (^slots [#artifact #versioning]))
(-> Metadata XML)
(let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
@@ -168,7 +72,7 @@
(list (..format_group group)
(..format_name name)
(..format_version version)
- (..format_versioning version versioning)))))
+ (///artifact/versioning.format versioning)))))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -180,135 +84,46 @@
(-> xml.Tag (Parser Text))
(..sub tag <xml>.text))
-(def: date_parser
- (<text>.Parser Date)
- (do <>.monad
- [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
- year (<>.lift (year.year (.int year)))
- month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- month (<>.lift (month.by_number month))
- day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
- (<>.lift (date.date year month day_of_month))))
-
-(def: time_parser
- (<text>.Parser Time)
- (do <>.monad
- [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- minute (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
- second (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
- (<>.lift (time.time
- {#time.hour hour
- #time.minute minute
- #time.second second
- #time.milli_second 0}))))
-
-(def: last_updated_parser
- (Parser Instant)
- (<text>.embed (do <>.monad
- [date ..date_parser
- time ..time_parser]
- (wrap (instant.from_date_time date time)))
- (..text ..<last_updated>)))
-
-(def: time_stamp_parser
- (Parser Time_Stamp)
- (<text>.embed (do <>.monad
- [date ..date_parser
- _ (<text>.this ..time_stamp_separator)
- time ..time_parser]
- (wrap (instant.from_date_time date time)))
- (..text ..<timestamp>)))
-
-(def: build_parser
- (Parser Build)
- (<text>.embed (<>.codec n.decimal
- (<text>.many <text>.decimal))
- (..text ..<build_number>)))
-
-(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text})
- (exception.report
- ["Expected time-stamp" (instant_format expected)]
- ["Actual time-stamp" actual]))
-
-(exception: #export (value_mismatch {expected Value} {actual Text})
- (exception.report
- ["Expected" (..value_format expected)]
- ["Actual" actual]))
-
-(def: (snapshot_parser expected)
- (-> Value (Parser Type))
- (<| (..sub ..<snapshot_version>)
- (do <>.monad
- [#let [[version time_stamp build] expected]
- updated (<xml>.somewhere (..text ..<updated>))
- _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
- (\ text.equivalence = (instant_format time_stamp) updated))
- actual (<xml>.somewhere (..text ..<value>))
- _ (<>.assert (exception.construct ..value_mismatch [expected actual])
- (\ text.equivalence = (..value_format expected) actual))]
- (<xml>.somewhere (..text ..<extension>)))))
-
-(def: (versioning_parser version)
- (-> Version (Parser Versioning))
- (<| (..sub ..<versioning>)
- (do <>.monad
- [[time_stamp build] (<| <xml>.somewhere
- (..sub ..<snapshot>)
- (<>.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))
- snapshot (<| <xml>.somewhere
- (..sub ..<snapshot_versions>)
- (<>.some (..snapshot_parser [version time_stamp build])))]
- (wrap {#time_stamp time_stamp
- #build build
- #snapshot snapshot}))))
-
(def: #export parser
(Parser Metadata)
(<| (..sub ..<metadata>)
- (do <>.monad
+ (do {! <>.monad}
[group (<xml>.somewhere (..text ..<group>))
name (<xml>.somewhere (..text ..<name>))
version (<xml>.somewhere (..text ..<version>))
- versioning (<xml>.somewhere (..versioning_parser version))]
+ versioning (\ ! map
+ (update@ #///artifact/versioning.versions
+ (: (-> (List ///artifact/snapshot/version.Version)
+ (List ///artifact/snapshot/version.Version))
+ (|>> (case> (^ (list))
+ (list {#///artifact/snapshot/version.extension ///artifact/type.jvm_library
+ #///artifact/snapshot/version.value version
+ #///artifact/snapshot/version.updated instant.epoch})
+
+ versions
+ versions))))
+ (<xml>.somewhere ///artifact/versioning.parser))]
(wrap {#artifact {#///artifact.group group
#///artifact.name name
#///artifact.version version}
#versioning versioning}))))
-(def: versioning_equivalence
- (Equivalence Versioning)
- ($_ product.equivalence
- instant.equivalence
- n.equivalence
- (list.equivalence text.equivalence)
- ))
-
(def: #export equivalence
(Equivalence Metadata)
($_ product.equivalence
///artifact.equivalence
- ..versioning_equivalence
+ ///artifact/versioning.equivalence
))
(def: #export (uri artifact)
(-> Artifact URI)
(let [/ uri.separator
- version (get@ #///artifact.version artifact)
- artifact (///artifact.uri artifact)]
- (%.format artifact / version / //.file)))
-
-(def: epoch
- Instant
- (instant.from_millis +0))
-
-(def: init_versioning
- {#time_stamp ..epoch
- #build 0
- #snapshot (list)})
+ group (|> artifact
+ (get@ #///artifact.group)
+ (///artifact.directory /))
+ name (get@ #///artifact.name artifact)
+ version (get@ #///artifact.version artifact)]
+ (%.format group / name / version / //.remote_file)))
(def: #export (read repository artifact)
(-> (Repository Promise) Artifact (Promise (Try Metadata)))
@@ -320,12 +135,12 @@
(do> try.monad
[(\ encoding.utf8 decode)]
[(\ xml.codec decode)]
- [(<xml>.run ..parser)])))
+ [list (<xml>.run ..parser)])))
(#try.Failure error)
(wrap (#try.Success
{#artifact artifact
- #versioning ..init_versioning})))))
+ #versioning ///artifact/versioning.init})))))
(def: #export (write repository artifact metadata)
(-> (Repository Promise) Artifact Metadata (Promise (Try Any)))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index f6ba87078..445c92987 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -10,6 +10,8 @@
["." sum]
["." product]
["." binary (#+ Binary)]
+ [text
+ ["." encoding]]
[format
["." xml (#+ XML)]]
[collection
@@ -21,12 +23,13 @@
[dependency (#+ Dependency)
["#." status (#+ Status)]]
[repository
+ [remote (#+ Address)]
["#." origin (#+ Origin)]]])
(type: #export Package
{#origin Origin
#library [Binary Status]
- #pom [XML Status]})
+ #pom [XML Binary Status]})
(template [<name> <tag>]
[(def: #export (<name> package)
@@ -46,19 +49,35 @@
(-> XML Binary Package)
{#origin (#//origin.Local "")
#library [library #//status.Unverified]
- #pom [pom #//status.Unverified]})
+ #pom [pom
+ (|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ #//status.Unverified]})
(def: #export dependencies
(-> Package (Try (Set Dependency)))
(|>> (get@ #pom)
product.left
+ list
(<xml>.run //pom.parser)
(try\map (get@ #/.dependencies))))
+(def: #export repositories
+ (-> Package (Try (Set Address)))
+ (|>> (get@ #pom)
+ product.left
+ list
+ (<xml>.run //pom.parser)
+ (try\map (get@ #/.repositories))))
+
(def: #export equivalence
(Equivalence Package)
($_ product.equivalence
//origin.equivalence
- (product.equivalence binary.equivalence //status.equivalence)
- (product.equivalence xml.equivalence //status.equivalence)
+ ($_ product.equivalence
+ binary.equivalence
+ //status.equivalence)
+ ($_ product.equivalence
+ xml.equivalence
+ binary.equivalence
+ //status.equivalence)
))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 4a21b341a..411b4665b 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -171,6 +171,9 @@
(<>.and <c>.text
..repository))))
+(def: default_repository
+ "https://repo1.maven.org/maven2/")
+
(def: profile
(Parser /.Profile)
(do {! <>.monad}
@@ -190,7 +193,8 @@
^repositories (: (Parser (Set //repository.Address))
(|> (..plural input "repositories" ..repository)
(\ ! map (set.from_list text.hash))
- (<>.default (set.new text.hash))))
+ (<>.default (set.new text.hash))
+ (\ ! map (set.add ..default_repository))))
^dependencies (: (Parser (Set //dependency.Dependency))
(|> (..plural input "dependencies" ..dependency)
(\ ! map (set.from_list //dependency.hash))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index f085e2808..f105f07b6 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -11,6 +11,7 @@
[data
["." name]
["." maybe ("#\." functor)]
+ ["." text]
[format
["_" xml (#+ Tag XML)]]
[collection
@@ -150,8 +151,8 @@
(<>.and <xml>.tag
(<xml>.children <xml>.text)))
-(def: parse_dependency
- (Parser Dependency)
+(def: (parse_dependency own_version parent_version)
+ (-> Text Text (Parser Dependency))
(do {! <>.monad}
[properties (\ ! map (dictionary.from_list name.hash)
(<xml>.children (<>.some ..parse_property)))]
@@ -159,28 +160,47 @@
try.from_maybe
(do maybe.monad
[group (dictionary.get ["" ..group_tag] properties)
- artifact (dictionary.get ["" ..artifact_tag] properties)
- version (dictionary.get ["" ..version_tag] properties)]
+ artifact (dictionary.get ["" ..artifact_tag] properties)]
(wrap {#//dependency.artifact {#//artifact.group group
#//artifact.name artifact
- #//artifact.version version}
+ #//artifact.version (|> properties
+ (dictionary.get ["" ..version_tag])
+ (maybe.default "")
+ (text.replace_all "${project.version}" own_version)
+ (text.replace_all "${project.parent.version}" parent_version))}
#//dependency.type (|> properties
(dictionary.get ["" "type"])
- (maybe.default //artifact/type.lux_library))})))))
+ (maybe.default //artifact/type.jvm_library))})))))
-(def: parse_dependencies
- (Parser (List Dependency))
+(def: (parse_dependencies own_version parent_version)
+ (-> Text Text (Parser (List Dependency)))
(do {! <>.monad}
[_ (<xml>.node ["" ..dependencies_tag])]
- (<xml>.children (<>.some ..parse_dependency))))
+ (<xml>.children (<>.some (..parse_dependency own_version parent_version)))))
+
+(def: own_version
+ (Parser Text)
+ (do <>.monad
+ [_ (<xml>.node ["" ..version_tag])]
+ (<xml>.children <xml>.text)))
+
+(def: parent_version
+ (Parser Text)
+ (do <>.monad
+ [_ (<xml>.node ["" "parent"])]
+ ..own_version))
(def: #export parser
(Parser /.Profile)
(do {! <>.monad}
- [_ (<xml>.node ["" ..project_tag])]
+ [own_version (<>.default "" (<xml>.somewhere ..own_version))
+ parent_version (<>.default "" (<xml>.somewhere ..parent_version))
+ _ (<xml>.node ["" ..project_tag])]
(<xml>.children
(do !
- [dependencies (<xml>.somewhere ..parse_dependencies)
+ [dependencies (|> (..parse_dependencies own_version parent_version)
+ <xml>.somewhere
+ (<>.default (list)))
_ (<>.some <xml>.ignore)]
(wrap (|> (\ /.monoid identity)
(update@ #/.dependencies (function (_ empty)
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index f313b3176..7ac384efa 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -19,7 +19,8 @@
["." uri (#+ URI)]]]]
["." //
["/#" // #_
- ["#." local]]])
+ ["#." local]
+ ["#." metadata]]])
(def: (root /)
(-> Text Path)
@@ -29,18 +30,23 @@
(-> Text URI Path)
(text.replace_all uri.separator))
-(def: (file program system uri)
+(def: (file program system create? uri)
(-> (Program Promise)
(file.System Promise)
+ Bit
URI
(Promise (Try (File Promise))))
(do {! promise.monad}
- [home (\ program home [])
+ [#let [uri (text.replace_once ///metadata.remote_file ///metadata.local_file uri)]
+ home (\ program home [])
#let [/ (\ system separator)
absolute_path (format home / (..root /) / (..path / uri))]]
- (do {! (try.with !)}
- [_ (: (Promise (Try Path))
- (file.make_directories promise.monad system (file.parent system absolute_path)))]
+ (if create?
+ (do {! (try.with !)}
+ [_ (: (Promise (Try Path))
+ (file.make_directories promise.monad system (file.parent system absolute_path)))]
+ (: (Promise (Try (File Promise)))
+ (file.get_file promise.monad system absolute_path)))
(: (Promise (Try (File Promise)))
(!.use (\ system file) absolute_path)))))
@@ -49,10 +55,10 @@
(def: (download uri)
(do {! (try.with promise.monad)}
- [file (..file program system uri)]
+ [file (..file program system false uri)]
(!.use (\ file content) [])))
(def: (upload uri content)
(do {! (try.with promise.monad)}
- [file (..file program system uri)]
+ [file (..file program system true uri)]
(!.use (\ file over_write) [content]))))
diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux
index 4979e5429..4b61bc36c 100644
--- a/stdlib/source/program/aedifex/repository/remote.lux
+++ b/stdlib/source/program/aedifex/repository/remote.lux
@@ -26,7 +26,7 @@
["." //
["#." identity (#+ Identity)]
["/#" // #_
- ["#." artifact (#+ Artifact)
+ ["#." artifact (#+ Version Artifact)
[extension (#+ Extension)]]]])
(type: #export Address
@@ -75,9 +75,9 @@
(exception.report
["Code" (%.int code)]))
-(def: #export (uri artifact extension)
- (-> Artifact Extension URI)
- (format (///artifact.uri artifact) extension))
+(def: #export (uri version_template artifact extension)
+ (-> Version Artifact Extension URI)
+ (format (///artifact.uri version_template artifact) extension))
(def: buffer_size
(n.* 512 1,024))
@@ -99,19 +99,21 @@
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))
+ #let [buffer (binary.create ..buffer_size)]
+ output (loop [output (\ binary.monoid identity)]
(do !
- [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))]
- (recur (\ binary.monoid compose output chunk)))))))))
+ [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)]
+ (case bytes_read
+ -1 (do !
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ +0 (recur output)
+ _ (if (n.= ..buffer_size bytes_read)
+ (recur (\ binary.monoid compose output buffer))
+ (do !
+ [chunk (\ io.monad wrap (binary.slice 0 (dec (.nat bytes_read)) buffer))]
+ (recur (\ binary.monoid compose output chunk)))))))]
+ (wrap output)))
(def: (upload uri content)
(case identity