diff options
Diffstat (limited to 'stdlib/source/program')
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 |