From 02d27daeacac74785c2b0f4d1ce03d432377a36e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 29 Dec 2020 23:29:54 -0400 Subject: Unified repository abstraction for Aedifex. --- stdlib/source/program/aedifex.lux | 21 ++- stdlib/source/program/aedifex/artifact.lux | 24 +-- stdlib/source/program/aedifex/cache.lux | 166 --------------------- stdlib/source/program/aedifex/command/build.lux | 19 ++- stdlib/source/program/aedifex/command/deploy.lux | 115 ++++---------- stdlib/source/program/aedifex/command/deps.lux | 20 ++- stdlib/source/program/aedifex/command/install.lux | 45 +++--- .../program/aedifex/dependency/deployment.lux | 128 ++++++++++++++++ .../program/aedifex/dependency/resolution.lux | 49 +++--- .../source/program/aedifex/dependency/status.lux | 7 + stdlib/source/program/aedifex/local.lux | 21 +-- stdlib/source/program/aedifex/metadata.lux | 31 +--- .../source/program/aedifex/metadata/artifact.lux | 99 ++++++++---- .../source/program/aedifex/metadata/snapshot.lux | 163 +++++++++++++------- stdlib/source/program/aedifex/repository/local.lux | 58 +++++++ 15 files changed, 513 insertions(+), 453 deletions(-) delete mode 100644 stdlib/source/program/aedifex/cache.lux create mode 100644 stdlib/source/program/aedifex/dependency/deployment.lux create mode 100644 stdlib/source/program/aedifex/repository/local.lux (limited to 'stdlib/source/program') diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 6a4deb3c3..52269d053 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -47,7 +47,8 @@ ["#." dependency #_ ["#" resolution (#+ Resolution)]] ["#." repository (#+ Repository) - ["#/." remote (#+ Address)]] + ["#/." remote (#+ Address)] + ["#/." local]] ["#." command (#+ Command) ["#/." version] ["#/." clean] @@ -71,7 +72,10 @@ (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) (Command a))) (do /action.monad - [resolution (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)] + [resolution (/command/deps.do! console + (/repository/local.repository program (file.async file.default)) + (..repositories profile) + profile)] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile))) (exception: (cannot_find_repository {repository Text} @@ -141,7 +145,8 @@ #/cli.Install (..command - (/command/install.do! program console (file.async file.default) profile)) + (let [fs (file.async file.default)] + (/command/install.do! console fs (/repository/local.repository program fs) profile))) (#/cli.Deploy repository identity) (..command @@ -162,7 +167,10 @@ #/cli.Dependencies (..command - (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)) + (/command/deps.do! console + (/repository/local.repository program (file.async file.default)) + (..repositories profile) + profile)) (#/cli.Compilation compilation) (case compilation @@ -182,5 +190,8 @@ (..command (case auto #/cli.Build (..with_dependencies program console (/command/auto.do! watcher /command/build.do!) profile) - #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))))) + #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))) + + _ + (undefined))) )))))) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index 6ba0a1e48..07b53157f 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -68,24 +68,14 @@ (text.split_all_with ..group_separator) (text.join_with separator))) -(def: (address separator artifact) - (-> Text Artifact Text) - (let [directory (%.format (..directory separator (get@ #group artifact)) - separator - (get@ #name artifact) - separator - (get@ #version artifact))] - (%.format directory - separator - (..identity artifact)))) - -(def: #export uri +(def: #export (uri artifact) (-> Artifact URI) - (..address uri.separator)) - -(def: #export (path system) - (All [!] (-> (file.System !) Artifact Path)) - (..address (\ system separator))) + (let [/ uri.separator + group (..directory / (get@ #group artifact)) + name (get@ #name artifact) + version (get@ #version artifact) + identity (..identity artifact)] + (%.format group / name / version / identity))) (def: #export (local artifact) (-> Artifact (List Text)) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux deleted file mode 100644 index a7f6439df..000000000 --- a/stdlib/source/program/aedifex/cache.lux +++ /dev/null @@ -1,166 +0,0 @@ -(.module: - [lux #* - [abstract - [codec (#+ Codec)] - ["." monad (#+ do)]] - [control - ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] - [data - [binary (#+ Binary)] - ["." product] - [text - ["%" format (#+ format)] - ["." encoding]] - [collection - ["." dictionary] - ["." set (#+ Set)] - ["." list]] - [format - ["." xml]]] - [world - [program (#+ Program)] - ["." file (#+ Path File Directory)]]] - ["." // #_ - ["#" local] - ["#." hash (#+ Hash SHA-1 MD5)] - ["#." package (#+ Package)] - ["#." artifact (#+ Artifact) - ["#/." type] - ["#/." extension (#+ Extension)]] - ["#." dependency (#+ Dependency) - [resolution (#+ Resolution)] - ["#/." status (#+ Status)]] - ["#." repository #_ - ["#/." origin]]]) - -(def: (write! system content file) - (-> (file.System Promise) Binary Path (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system file))] - (!.use (\ file over_write) [content]))) - -(def: (write_hashed system directory [artifact type] [data status]) - (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any))) - (let [prefix (format directory - (\ system separator) - (//artifact.identity artifact) - (//artifact/extension.extension type))] - (do {! (try.with promise.monad)} - [_ (..write! system data prefix) - #let [write_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) - (function (_ codec extension hash) - (..write! system - (|> hash (\ codec encode) (\ encoding.utf8 encode)) - (format prefix extension))))]] - (case status - #//dependency/status.Unverified - (wrap []) - - (#//dependency/status.Partial partial) - (case partial - (#.Left sha-1) - (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1) - - (#.Right md5) - (write_hash //hash.md5_codec //artifact/extension.md5 md5)) - - (#//dependency/status.Verified sha-1 md5) - (do ! - [_ (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1)] - (write_hash //hash.md5_codec //artifact/extension.md5 md5)))))) - -(def: #export (write_one program system [artifact type] package) - (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact))) - (do promise.monad - [home (\ program home [])] - (do (try.with promise.monad) - [directory (: (Promise (Try Path)) - (file.make_directories promise.monad system (//.path system home artifact))) - _ (write_hashed system directory [artifact type] (get@ #//package.library package)) - _ (let [[pom status] (get@ #//package.pom package)] - (write_hashed system directory - [artifact //artifact/type.pom] - [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) - status]))] - (wrap artifact)))) - -(def: #export (write_all program system resolution) - (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact)))) - (do {! (try.with promise.monad)} - [] - (|> (dictionary.entries resolution) - (list.filter (|>> product.right //package.local? not)) - (monad.map ! (function (_ [dependency package]) - (..write_one program system dependency package))) - (\ ! map (set.from_list //artifact.hash))))) - -(def: (read! system path) - (-> (file.System Promise) Path (Promise (Try Binary))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (!.use (\ system file) path))] - (!.use (\ file content) []))) - -(def: (decode codec data) - (All [a] (-> (Codec Text a) Binary (Try a))) - (let [(^open "_\.") try.monad] - (|> data - (\ encoding.utf8 decode) - (_\map (\ codec decode)) - _\join))) - -(def: #export (read_one program system [artifact type]) - (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package))) - (do promise.monad - [home (\ program home []) - #let [prefix (format (//.path system home artifact) - (\ system separator) - (//artifact.identity artifact))]] - (do (try.with promise.monad) - [pom (..read! system (format prefix //artifact/extension.pom)) - #let [extension (//artifact/extension.extension type)] - library (..read! system (format prefix extension)) - library_sha-1 (..read! system (format prefix extension //artifact/extension.sha-1)) - library_md5 (..read! system (format prefix extension //artifact/extension.md5))] - (\ promise.monad wrap - (do try.monad - [pom (..decode xml.codec pom) - library_sha-1 (..decode //hash.sha-1_codec library_sha-1) - library_md5 (..decode //hash.md5_codec library_md5)] - (wrap {#//package.origin (#//repository/origin.Local prefix) - #//package.library [library (#//dependency/status.Verified library_sha-1 library_md5)] - #//package.pom [pom #//dependency/status.Unverified]})))))) - -(def: #export (read_all program system dependencies resolution) - (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) - (case dependencies - #.Nil - (\ (try.with promise.monad) wrap resolution) - - (#.Cons head tail) - (do promise.monad - [package (case (dictionary.get head resolution) - (#.Some package) - (wrap (#try.Success package)) - - #.None - (..read_one program system head))] - (with_expansions [ (as_is (read_all program system tail resolution))] - (case package - (#try.Success package) - (do (try.with promise.monad) - [sub_dependencies (|> package - //package.dependencies - (\ promise.monad wrap)) - resolution (|> resolution - (dictionary.put head package) - (read_all program system (set.to_list sub_dependencies)))] - ) - - (#try.Failure error) - ))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index a05d7ad85..7241b1de4 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -26,13 +26,14 @@ [program (#+ Program)] ["." file (#+ Path)] ["." shell (#+ Shell)] - ["." console (#+ Console)]]] + ["." console (#+ Console)] + [net + ["." uri]]]] ["." /// #_ ["#" profile] ["#." action] ["#." command (#+ Command)] ["#." local] - ["#." cache] ["#." repository] ["#." runtime] ["#." dependency (#+ Dependency) @@ -102,11 +103,19 @@ _ (exception.throw ..no_available_compiler []))) +(def: (path fs home artifact) + (All [!] (-> (file.System !) Path Artifact Path)) + (let [/ (\ fs separator)] + (|> artifact + ///local.uri + (text.replace_all uri.separator /) + (format home /)))) + (def: (libraries fs home) (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library))) - (list\map (|>> (get@ #///dependency.artifact) (///local.path fs home))))) + (list\map (|>> (get@ #///dependency.artifact) (..path fs home))))) (def: (singular name) (-> Text Text (List Text)) @@ -138,9 +147,9 @@ (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) #let [[command output] (let [[compiler output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs home artifact)) + (#JVM artifact) [(///runtime.java (..path fs home artifact)) "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs home artifact)) + (#JS artifact) [(///runtime.node (..path fs home artifact)) "program.js"])] [(format compiler " build") output]) / (\ fs separator) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index b00f964d7..fe96055ef 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -36,9 +36,14 @@ ["#." action (#+ Action)] ["#." pom] ["#." hash] + ["#." package] + ["#." dependency + ["#/." deployment] + ["#/." status (#+ Status)]] ["#." repository (#+ Repository) [identity (#+ Identity)] - ["#/." remote]] + ["#/." remote] + ["#/." origin]] ["#." metadata ["#/." artifact] ["#/." snapshot]] @@ -46,94 +51,24 @@ ["#/." extension (#+ Extension)] ["#/." type]]]]) -(def: epoch - Instant - (instant.from_millis +0)) - -(template [ ] - [(def: ( repository artifact) - (-> (Repository Promise) Artifact (Promise (Try ))) - (do promise.monad - [project (\ repository download ( artifact))] - (case project - (#try.Success project) - (wrap (|> project - (do> try.monad - [(\ encoding.utf8 decode)] - [(\ xml.codec decode)] - [(.run )]))) - - (#try.Failure error) - (wrap (#try.Success )))))] - - [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 artifact profile) (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any)) - (let [deploy! (: (-> Extension Binary (Action Any)) - (|>> (///repository/remote.uri artifact) - (\ repository upload))) - 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 (///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 (///metadata.project artifact)))] - (console.write_line //clean.success console))))) + (do {! ///action.monad} + [library (|> profile + (get@ #/.sources) + set.to_list + (export.library fs) + (\ ! map (binary.run tar.writer))) + pom (\ promise.monad wrap (///pom.write profile)) + _ (///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)]})] + (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 315c6375c..71dffeec1 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -7,7 +7,9 @@ ["." promise (#+ Promise)]]] [data [collection - ["." set (#+ Set)]]] + ["." set (#+ Set)] + ["." list ("#\." fold)] + ["." dictionary]]] [world [program (#+ Program)] ["." file] @@ -20,16 +22,18 @@ [repository (#+ Repository)] ["#" profile] ["#." action (#+ Action)] - ["#." cache] ["#." dependency #_ - ["#/." resolution (#+ Resolution)]]]]) + ["#/." resolution (#+ Resolution)] + ["#/." deployment]]]]) -(def: #export (do! program console fs repositories profile) - (-> (Program Promise) (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) +(def: #export (do! console local remotes profile) + (-> (Console Promise) (Repository Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad [#let [dependencies (set.to_list (get@ #///.dependencies profile))] - cache (///cache.read_all program fs dependencies ///dependency/resolution.empty) - resolution (///dependency/resolution.all repositories dependencies cache) - cached (///cache.write_all program fs resolution) + 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))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 033b41b40..b051a4900 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -35,36 +35,35 @@ ["#." command (#+ Command)] ["#." local] ["#." pom] + ["#." package] + [repository (#+ Repository) + ["#." origin]] + ["#." dependency #_ + ["#/." deployment] + ["#/." status]] ["#." artifact (#+ Artifact) - ["#/." extension]]]]) - -(def: (save! system content file) - (-> (file.System Promise) Binary Path (Promise (Try Any))) - (do (try.with promise.monad) - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad system file))] - (!.use (\ file over_write) [content]))) + ["#/." type]]]]) (def: #export failure "Failure: No 'identity' defined for the project.") -(def: #export (do! program console system profile) - (-> (Program Promise) (Console Promise) (file.System Promise) (Command Any)) +(def: #export (do! console system repository profile) + (-> (Console Promise) (file.System Promise) (Repository Promise) (Command Any)) (case (get@ #/.identity profile) (#.Some identity) - (do promise.monad - [home (\ program home [])] - (do ///action.monad - [package (export.library system (set.to_list (get@ #/.sources profile))) - repository (: (Promise (Try Path)) - (file.make_directories promise.monad system (///local.path system home identity))) - #let [artifact_name (format repository (\ system separator) (///artifact.identity identity))] - _ (..save! system (binary.run tar.writer package) - (format artifact_name ///artifact/extension.lux_library)) - pom (\ promise.monad wrap (///pom.write profile)) - _ (..save! system (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) - (format artifact_name ///artifact/extension.pom))] - (console.write_line //clean.success console))) + (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)]})] + (console.write_line //clean.success console)) _ (console.write_line ..failure console))) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux new file mode 100644 index 000000000..1f3e776a9 --- /dev/null +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -0,0 +1,128 @@ +(.module: + [lux #* + [abstract + [codec (#+ Codec)] + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + ["." product] + [text + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." dictionary] + ["." set (#+ Set)] + ["." list ("#\." monoid)]] + [format + ["." xml]]] + [time + ["." instant]] + [world + [program (#+ Program)] + ["." file (#+ Path File Directory)]]] + ["." /// #_ + ["#" local] + ["#." hash (#+ Hash SHA-1 MD5)] + ["#." package (#+ Package)] + ["#." artifact (#+ Artifact) + ["#/." type] + ["#/." extension (#+ Extension)]] + ["#." metadata + ["#/." artifact] + ["#/." snapshot]] + ["#." dependency (#+ Dependency) + [resolution (#+ Resolution)] + ["#/." status (#+ Status)]] + ["#." 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) + (///artifact/extension.extension type)) + deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) + (function (_ codec extension hash) + (|> hash + (\ codec encode) + (\ encoding.utf8 encode) + (\ repository upload (format artifact extension)))))] + (do {! (try.with promise.monad)} + [_ (\ repository upload artifact data)] + (case status + #///dependency/status.Unverified + (wrap []) + + (#///dependency/status.Partial partial) + (case partial + (#.Left sha-1) + (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1) + + (#.Right md5) + (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5)) + + (#///dependency/status.Verified sha-1 md5) + (do ! + [_ (deploy_hash ///hash.sha-1_codec ///artifact/extension.sha-1 sha-1)] + (deploy_hash ///hash.md5_codec ///artifact/extension.md5 md5)))))) + +(def: (artifacts type status) + (-> ///artifact/type.Type Status (List ///artifact/type.Type)) + (with_expansions [ (format type ///artifact/extension.sha-1) + (format type ///artifact/extension.md5)] + (list& type + (case status + #///dependency/status.Unverified + (list) + + (#///dependency/status.Partial partial) + (list (case partial + (#.Left _) + (#.Right _) )) + + (#///dependency/status.Verified _) + (list ))))) + +(def: #export (one repository [artifact type] package) + (-> (Repository Promise) Dependency Package (Promise (Try Artifact))) + (do {! promise.monad} + [now (promise.future instant.now)] + (do (try.with !) + [_ (with_status repository [artifact type] (get@ #///package.library package)) + + _ (let [[pom status] (get@ #///package.pom package)] + (with_status repository + [artifact ///artifact/type.pom] + [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) + status])) + + snapshot (///metadata/snapshot.read repository artifact) + _ (|> 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))))) + (///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.last_updated now) + (///metadata/artifact.write repository artifact))] + (wrap artifact)))) + +(def: #export (all repository resolution) + (-> (Repository Promise) Resolution (Promise (Try (Set Artifact)))) + (do {! (try.with promise.monad)} + [] + (|> (dictionary.entries resolution) + (monad.map ! (function (_ [dependency package]) + (..one repository dependency package))) + (\ ! map (set.from_list ///artifact.hash))))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 1b40a3004..e6b24b152 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -60,28 +60,43 @@ (-> Binary (Repository Promise) Artifact Extension (-> Binary (Hash h)) (Codec Text (Hash h)) (Exception [Artifact Extension Text]) - (Promise (Try (Hash h))))) - (do (try.with promise.monad) - [actual (\ repository download (///repository/remote.uri artifact extension))] - (\ promise.monad wrap - (do try.monad - [output (\ encoding.utf8 decode actual) - actual (\ codec decode output) - _ (exception.assert exception [artifact extension output] - (\ ///hash.equivalence = (hash library) actual))] - (wrap actual))))) + (Promise (Try (Maybe (Hash h)))))) + (do promise.monad + [?actual (\ repository download (///repository/remote.uri artifact extension))] + (case ?actual + (#try.Success actual) + (wrap (do try.monad + [output (\ encoding.utf8 decode actual) + actual (\ codec decode output) + _ (exception.assert exception [artifact extension output] + (\ ///hash.equivalence = (hash library) actual))] + (wrap (#.Some actual)))) + + (#try.Failure error) + (wrap (#try.Success #.None))))) (def: (hashed repository artifact extension) (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status]))) (do (try.with promise.monad) [data (\ repository download (///repository/remote.uri artifact extension)) - sha-1 (..verified_hash data - repository 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) - ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] - (wrap [data (#//status.Verified sha-1 md5)]))) + ?sha-1 (..verified_hash data + repository 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) + ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] + (wrap [data (case [?sha-1 ?md5] + [(#.Some sha-1) (#.Some md5)] + (#//status.Verified sha-1 md5) + + [(#.Some sha-1) _] + (#//status.Partial (#.Left sha-1)) + + [_ (#.Some md5)] + (#//status.Partial (#.Right md5)) + + [#.None #.None] + #//status.Unverified)]))) (def: #export (one repository dependency) (-> (Repository Promise) Dependency (Promise (Try Package))) diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index bedaffdb8..82d99e9aa 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -3,6 +3,7 @@ [abstract [equivalence (#+ Equivalence)]] [data + [binary (#+ Binary)] ["." sum] ["." product]]] ["." /// #_ @@ -33,3 +34,9 @@ ///hash.equivalence ) )) + +(def: #export (verified payload) + (-> Binary Status) + (#Verified + (///hash.sha-1 payload) + (///hash.md5 payload))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index e1927e577..279973c1a 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -4,17 +4,18 @@ [text ["%" format (#+ format)]]] [world - ["." file (#+ Path)]]] + [net + ["." uri (#+ URI)]]]] ["." // #_ ["#." artifact (#+ Artifact)]]) -(def: #export (repository system home) - (All [a] (-> (file.System a) Path Path)) - (let [/ (\ system separator)] - (format home / ".m2" / "repository"))) +(def: / uri.separator) -(def: #export (path system home artifact) - (All [a] (-> (file.System a) Path Artifact Path)) - (format (..repository system home) - (\ system separator) - (//artifact.path system artifact))) +(def: #export repository + URI + (format ".m2" / "repository")) + +(def: #export uri + (-> Artifact URI) + (|>> //artifact.uri + (format ..repository /))) diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux index 11a792528..0eca976c0 100644 --- a/stdlib/source/program/aedifex/metadata.lux +++ b/stdlib/source/program/aedifex/metadata.lux @@ -1,37 +1,8 @@ (.module: [lux #* - [data - ["." text - ["%" format (#+ format)]]] [world - [file (#+ Path)] - [net - ["." uri (#+ URI)]]]] - [// - ["." artifact (#+ Artifact)]]) + [file (#+ Path)]]]) (def: #export file Path "maven-metadata.xml") - -(def: (project' separator artifact) - (-> Text Artifact Text) - (format (artifact.directory separator (get@ #artifact.group artifact)) - separator - (get@ #artifact.name artifact))) - -(def: (version' separator artifact) - (-> Text Artifact Text) - (format (..project' separator artifact) - separator - (get@ #artifact.version artifact))) - -(template [ ] - [(def: #export ( artifact) - (-> Artifact URI) - (let [/ uri.separator] - (format ( / artifact) / ..file)))] - - [project ..project'] - [version ..version'] - ) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 5762bf49d..c1d98a8b5 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -4,13 +4,18 @@ [monad (#+ do)] [equivalence (#+ Equivalence)]] [control + [pipe (#+ do>)] + ["." try (#+ Try)] ["<>" parser ["<.>" xml (#+ Parser)] - ["<.>" text]]] + ["<.>" text]] + [concurrency + ["." promise (#+ Promise)]]] [data ["." product] ["." text - ["%" format (#+ format)]] + ["%" format] + ["." encoding]] [format ["." xml (#+ XML)]] [collection @@ -22,9 +27,14 @@ ["." instant (#+ Instant)] ["." date (#+ Date)] ["." year] - ["." month]]] - ["." /// #_ - ["#." artifact (#+ Group Name Version Artifact)]]) + ["." month]] + [world + [net + ["." uri (#+ URI)]]]] + ["." // + ["/#" // #_ + [repository (#+ Repository)] + ["#." artifact (#+ Group Name Version Artifact)]]]) (type: #export Metadata {#group Group @@ -35,26 +45,26 @@ (def: (pad value) (-> Nat Text) (if (n.< 10 value) - (format "0" (%.nat 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))) + (%.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)))) + (%.format (..pad hour) + (..pad minute) + (..pad second)))) (def: (instant_format value) (%.Format Instant) - (format (..date_format (instant.date value)) - (..time_format (instant.time value)))) + (%.format (..date_format (instant.date value)) + (..time_format (instant.time value)))) (template [ ] [(def: xml.Tag ["" ])] @@ -73,26 +83,26 @@ (-> XML) (|>> 
 #xml.Text list (#xml.Node  xml.attributes)))]
 
-  [write_group Group .. (|>)]
-  [write_name Name .. (|>)]
-  [write_version Version .. (|>)]
-  [write_last_updated Instant .. ..instant_format]
+  [format_group Group .. (|>)]
+  [format_name Name .. (|>)]
+  [format_version Version .. (|>)]
+  [format_last_updated Instant .. ..instant_format]
   )
 
-(def: write_versions
+(def: format_versions
   (-> (List Version) XML)
-  (|>> (list\map ..write_version) (#xml.Node .. xml.attributes)))
+  (|>> (list\map ..format_version) (#xml.Node .. xml.attributes)))
 
-(def: #export (write value)
+(def: #export (format value)
   (-> Metadata XML)
   (#xml.Node ..
              xml.attributes
-             (list (..write_group (get@ #group value))
-                   (..write_name (get@ #name value))
+             (list (..format_group (get@ #group value))
+                   (..format_name (get@ #name value))
                    (#xml.Node ..
                               xml.attributes
-                              (list (..write_versions (get@ #versions value))
-                                    (..write_last_updated (get@ #last_updated value)))))))
+                              (list (..format_versions (get@ #versions value))
+                                    (..format_last_updated (get@ #last_updated value)))))))
 
 (def: (sub tag parser)
   (All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -157,3 +167,42 @@
       (list.equivalence text.equivalence)
       instant.equivalence
       ))
+
+(def: #export (uri artifact)
+  (-> Artifact URI)
+  (let [/ uri.separator
+        group (///artifact.directory / (get@ #///artifact.group artifact))
+        name (get@ #///artifact.name artifact)]
+    (%.format group / name / //.file)))
+
+(def: epoch
+  Instant
+  (instant.from_millis +0))
+
+(def: #export (read repository artifact)
+  (-> (Repository Promise) Artifact (Promise (Try Metadata)))
+  (do promise.monad
+    [project (\ repository download (..uri artifact))]
+    (case project
+      (#try.Success project)
+      (wrap (|> project
+                (do> try.monad
+                     [(\ encoding.utf8 decode)]
+                     [(\ xml.codec decode)]
+                     [(.run ..parser)])))
+      
+      (#try.Failure error)
+      (wrap (#try.Success
+             (let [(^slots [#///artifact.group #///artifact.name]) artifact]
+               {#group group
+                #name name
+                #versions (list)
+                #last_updated ..epoch}))))))
+
+(def: #export (write repository artifact metadata)
+  (-> (Repository Promise) Artifact Metadata (Promise (Try Any)))
+  (|> metadata
+      ..format
+      (\ xml.codec encode)
+      (\ encoding.utf8 encode)
+      (\ repository upload (..uri artifact))))
diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux
index 38af9a729..99ad25470 100644
--- a/stdlib/source/program/aedifex/metadata/snapshot.lux
+++ b/stdlib/source/program/aedifex/metadata/snapshot.lux
@@ -4,14 +4,19 @@
     [monad (#+ do)]
     [equivalence (#+ Equivalence)]]
    [control
+    [pipe (#+ do>)]
+    ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     ["<>" parser
      ["<.>" xml (#+ Parser)]
-     ["<.>" text]]]
+     ["<.>" text]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     ["." product]
     ["." text
-     ["%" format (#+ format)]]
+     ["%" format]
+     ["." encoding]]
     [format
      ["." xml (#+ XML)]]
     [collection
@@ -23,10 +28,16 @@
     ["." instant (#+ Instant)]
     ["." date (#+ Date)]
     ["." year]
-    ["." month]]]
-  ["." /// #_
-   ["#." artifact (#+ Group Name Version Artifact)
-    ["#/." type (#+ Type)]]])
+    ["." month]]
+   [world
+    [net
+     ["." uri (#+ URI)]]]]
+  ["." //
+   ["." artifact]
+   ["/#" // #_
+    [repository (#+ Repository)]
+    ["#." artifact (#+ Group Name Version Artifact)
+     ["#/." type (#+ Type)]]]])
 
 (def: snapshot
   "SNAPSHOT")
@@ -46,34 +57,32 @@
   [Version Time_Stamp Build])
 
 (type: #export Metadata
-  {#group Group
-   #name Name
-   #version Version
+  {#artifact Artifact
    #versioning Versioning})
 
 (def: (pad value)
   (-> Nat Text)
   (if (n.< 10 value)
-    (format "0" (%.nat 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)))
+  (%.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))))
+    (%.format (..pad hour)
+              (..pad minute)
+              (..pad second))))
 
 (def: (instant_format value)
   (%.Format Instant)
-  (format (..date_format (instant.date value))
-          (..time_format (instant.time value))))
+  (%.format (..date_format (instant.date value))
+            (..time_format (instant.time value))))
 
 (template [ ]
   [(def: 
@@ -85,17 +94,17 @@
 
 (def: (time_stamp_format value)
   (%.Format Time_Stamp)
-  (format (..date_format (instant.date value))
-          ..time_stamp_separator
-          (..time_format (instant.time value))))
+  (%.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)))
+  (%.format (text.replace_all ..snapshot
+                              (..time_stamp_format time_stamp)
+                              version)
+            ..value_separator
+            (%.nat build)))
 
 (template [ ]
   [(def:  xml.Tag ["" ])]
@@ -121,44 +130,45 @@
      (->  XML)
      (|>> 
 #xml.Text list (#xml.Node  xml.attributes)))]
 
-  [write_group Group .. (|>)]
-  [write_name Name .. (|>)]
-  [write_version Version .. (|>)]
-  [write_last_updated Instant .. ..instant_format]
-  [write_time_stamp Instant .. ..time_stamp_format]
-  [write_build_number Nat .. %.nat]
-  [write_extension Type .. (|>)]
-  [write_value Value .. ..value_format]
-  [write_updated Instant .. ..instant_format]
+  [format_group Group .. (|>)]
+  [format_name Name .. (|>)]
+  [format_version Version .. (|>)]
+  [format_last_updated Instant .. ..instant_format]
+  [format_time_stamp Instant .. ..time_stamp_format]
+  [format_build_number Nat .. %.nat]
+  [format_extension Type .. (|>)]
+  [format_value Value .. ..value_format]
+  [format_updated Instant .. ..instant_format]
   )
 
-(def: (write_snapshot value type)
+(def: (format_snapshot value type)
   (-> Value Type XML)
   (<| (#xml.Node .. xml.attributes)
-      (list (..write_extension type)
-            (..write_value value)
+      (list (..format_extension type)
+            (..format_value value)
             (let [[version time_stamp build] value]
-              (..write_updated time_stamp)))))
+              (..format_updated time_stamp)))))
 
-(def: (write_versioning version (^slots [#time_stamp #build #snapshot]))
+(def: (format_versioning version (^slots [#time_stamp #build #snapshot]))
   (-> Version Versioning XML)
   (<| (#xml.Node .. xml.attributes)
       (list (<| (#xml.Node .. xml.attributes)
-                (list (..write_time_stamp time_stamp)
-                      (..write_build_number build)))
-            (..write_last_updated time_stamp)
+                (list (..format_time_stamp time_stamp)
+                      (..format_build_number build)))
+            (..format_last_updated time_stamp)
             (<| (#xml.Node .. xml.attributes)
-                (list\map (..write_snapshot [version time_stamp build])
+                (list\map (..format_snapshot [version time_stamp build])
                           snapshot)))))
 
-(def: #export (write (^slots [#group #name #version #versioning]))
+(def: #export (format (^slots [#artifact #versioning]))
   (-> Metadata XML)
-  (#xml.Node ..
-             xml.attributes
-             (list (..write_group group)
-                   (..write_name name)
-                   (..write_version version)
-                   (..write_versioning version versioning))))
+  (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact]
+    (#xml.Node ..
+               xml.attributes
+               (list (..format_group group)
+                     (..format_name name)
+                     (..format_version version)
+                     (..format_versioning version versioning)))))
 
 (def: (sub tag parser)
   (All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -264,9 +274,9 @@
          name (.somewhere (..text ..))
          version (.somewhere (..text ..))
          versioning (.somewhere (..versioning_parser version))]
-        (wrap {#group group
-               #name name
-               #version version
+        (wrap {#artifact {#///artifact.group group
+                          #///artifact.name name
+                          #///artifact.version version}
                #versioning versioning}))))
 
 (def: versioning_equivalence
@@ -280,8 +290,47 @@
 (def: #export equivalence
   (Equivalence Metadata)
   ($_ product.equivalence
-      text.equivalence
-      text.equivalence
-      text.equivalence
+      ///artifact.equivalence
       ..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)})
+
+(def: #export (read repository artifact)
+  (-> (Repository Promise) Artifact (Promise (Try Metadata)))
+  (do promise.monad
+    [project (\ repository download (..uri artifact))]
+    (case project
+      (#try.Success project)
+      (wrap (|> project
+                (do> try.monad
+                     [(\ encoding.utf8 decode)]
+                     [(\ xml.codec decode)]
+                     [(.run ..parser)])))
+      
+      (#try.Failure error)
+      (wrap (#try.Success
+             {#artifact artifact
+              #versioning ..init_versioning})))))
+
+(def: #export (write repository artifact metadata)
+  (-> (Repository Promise) Artifact Metadata (Promise (Try Any)))
+  (|> metadata
+      ..format
+      (\ xml.codec encode)
+      (\ encoding.utf8 encode)
+      (\ repository upload (..uri artifact))))
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
new file mode 100644
index 000000000..393861ccf
--- /dev/null
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -0,0 +1,58 @@
+(.module:
+  [lux #*
+   [host (#+ import:)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    ["." text
+     ["%" format (#+ format)]]]
+   [world
+    [program (#+ Program)]
+    ["." file (#+ Path File)]
+    [net
+     ["." uri (#+ URI)]]]]
+  ["." //
+   ["/#" // #_
+    ["#." local]]])
+
+(def: (root /)
+  (-> Text Path)
+  (text.replace_all uri.separator / ///local.repository))
+
+(def: path
+  (-> Text URI Path)
+  (text.replace_all uri.separator))
+
+(def: (file program system uri)
+  (-> (Program Promise)
+      (file.System Promise)
+      URI
+      (Promise (Try (File Promise))))
+  (do {! promise.monad}
+    [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)))]
+      (: (Promise (Try (File Promise)))
+         (file.get_file promise.monad system absolute_path)))))
+
+(structure: #export (repository program system)
+  (-> (Program Promise) (file.System Promise) (//.Repository Promise))
+
+  (def: (download uri)
+    (do {! (try.with promise.monad)}
+      [file (..file program system uri)]
+      (!.use (\ file content) [])))
+
+  (def: (upload uri content)
+    (do {! (try.with promise.monad)}
+      [file (..file program system uri)]
+      (!.use (\ file over_write) [content]))))
-- 
cgit v1.2.3