diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/artifact.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cache.lux | 166 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy.lux | 115 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deps.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/install.lux | 45 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/deployment.lux | 128 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/resolution.lux | 49 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/status.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/metadata.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/metadata/artifact.lux | 99 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/metadata/snapshot.lux | 163 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository/local.lux | 58 |
15 files changed, 513 insertions, 453 deletions
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 [<next> (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)))] - <next>) - - (#try.Failure error) - <next>))))) 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 [<name> <type> <uri> <parser> <default>] - [(def: (<name> repository artifact) - (-> (Repository Promise) Artifact (Promise (Try <type>))) - (do promise.monad - [project (\ repository download (<uri> artifact))] - (case project - (#try.Success project) - (wrap (|> project - (do> try.monad - [(\ encoding.utf8 decode)] - [(\ xml.codec decode)] - [(<xml>.run <parser>)]))) - - (#try.Failure error) - (wrap (#try.Success <default>)))))] - - [read_project_metadata ///metadata/artifact.Metadata ///metadata.project ///metadata/artifact.parser - (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact] - {#///metadata/artifact.group group - #///metadata/artifact.name name - #///metadata/artifact.versions (list) - #///metadata/artifact.last_updated ..epoch})] - [read_version_metadata ///metadata/snapshot.Metadata ///metadata.version ///metadata/snapshot.parser - (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact] - {#///metadata/snapshot.group group - #///metadata/snapshot.name name - #///metadata/snapshot.version version - #///metadata/snapshot.versioning {#///metadata/snapshot.time_stamp ..epoch - #///metadata/snapshot.build 0 - #///metadata/snapshot.snapshot (list)}})] - ) - -(def: snapshot_artifacts - (List ///artifact/type.Type) - (list ///artifact/type.pom - (format ///artifact/type.pom ///artifact/extension.sha-1) - (format ///artifact/type.pom ///artifact/extension.md5) - ///artifact/type.lux_library - (format ///artifact/type.lux_library ///artifact/extension.sha-1) - (format ///artifact/type.lux_library ///artifact/extension.md5))) - (def: #export (do! console repository fs 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 [<sha-1> (format type ///artifact/extension.sha-1) + <md5> (format type ///artifact/extension.md5)] + (list& type + (case status + #///dependency/status.Unverified + (list) + + (#///dependency/status.Partial partial) + (list (case partial + (#.Left _) <sha-1> + (#.Right _) <md5>)) + + (#///dependency/status.Verified _) + (list <sha-1> <md5>))))) + +(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 [<public> <private>] - [(def: #export (<public> artifact) - (-> Artifact URI) - (let [/ uri.separator] - (format (<private> / 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 [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -73,26 +83,26 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write_group Group ..<group> (|>)] - [write_name Name ..<name> (|>)] - [write_version Version ..<version> (|>)] - [write_last_updated Instant ..<last_updated> ..instant_format] + [format_group Group ..<group> (|>)] + [format_name Name ..<name> (|>)] + [format_version Version ..<version> (|>)] + [format_last_updated Instant ..<last_updated> ..instant_format] ) -(def: write_versions +(def: format_versions (-> (List Version) XML) - (|>> (list\map ..write_version) (#xml.Node ..<versions> xml.attributes))) + (|>> (list\map ..format_version) (#xml.Node ..<versions> xml.attributes))) -(def: #export (write value) +(def: #export (format value) (-> Metadata XML) (#xml.Node ..<metadata> 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 ..<versioning> 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)] + [(<xml>.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 [<separator> <name>] [(def: <name> @@ -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 [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -121,44 +130,45 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write_group Group ..<group> (|>)] - [write_name Name ..<name> (|>)] - [write_version Version ..<version> (|>)] - [write_last_updated Instant ..<last_updated> ..instant_format] - [write_time_stamp Instant ..<timestamp> ..time_stamp_format] - [write_build_number Nat ..<build_number> %.nat] - [write_extension Type ..<extension> (|>)] - [write_value Value ..<value> ..value_format] - [write_updated Instant ..<updated> ..instant_format] + [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: (write_snapshot value type) +(def: (format_snapshot value type) (-> Value Type XML) (<| (#xml.Node ..<snapshot_version> 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 ..<versioning> xml.attributes) (list (<| (#xml.Node ..<snapshot> 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 ..<snapshot_versions> 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 ..<metadata> - 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 ..<metadata> + 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 (<xml>.somewhere (..text ..<name>)) version (<xml>.somewhere (..text ..<version>)) versioning (<xml>.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)] + [(<xml>.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])))) |