From 03b1085924b225d34d3b11f1a442b0b5d926c417 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 2 Nov 2020 17:31:39 -0400 Subject: Allow defining anonymous actors. --- stdlib/source/program/aedifex.lux | 10 +- stdlib/source/program/aedifex/cache.lux | 138 ++++++++++++++++++++ stdlib/source/program/aedifex/command/build.lux | 9 +- .../program/aedifex/dependency/resolution.lux | 5 + stdlib/source/program/aedifex/local.lux | 139 +-------------------- stdlib/source/program/aedifex/package.lux | 15 ++- 6 files changed, 169 insertions(+), 147 deletions(-) create mode 100644 stdlib/source/program/aedifex/cache.lux (limited to 'stdlib/source/program') diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index f3f222d90..a3712a19f 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -37,7 +37,7 @@ ["#." parser] ["#." pom] ["#." cli] - ["#." local] + ["#." cache] ["#." dependency #_ ["#" resolution]] ["#." command @@ -52,14 +52,14 @@ (-> /.Profile (Promise Any)) (do promise.monad [outcome (do (try.with promise.monad) - [cache (/local.all-cached (file.async file.default) - (set.to-list (get@ #/.dependencies profile)) - /dependency.empty) + [cache (/cache.read-all (file.async file.default) + (set.to-list (get@ #/.dependencies profile)) + /dependency.empty) resolution (promise.future (/dependency.resolve-all (set.to-list (get@ #/.repositories profile)) (set.to-list (get@ #/.dependencies profile)) cache))] - (/local.cache-all (file.async file.default) + (/cache.write-all (file.async file.default) resolution))] (wrap (case outcome (#try.Success _) diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux new file mode 100644 index 000000000..2a81b2869 --- /dev/null +++ b/stdlib/source/program/aedifex/cache.lux @@ -0,0 +1,138 @@ +(.module: + [lux #* + [abstract + [codec (#+ Codec)] + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + [text + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." dictionary] + ["." set]] + [format + ["." xml]]] + [world + ["." file (#+ Path File Directory)]]] + ["." // #_ + ["#" local] + ["#." hash] + ["#." package (#+ Package)] + ["#." artifact + ["#/." extension]] + [dependency (#+ Dependency) + [resolution (#+ Resolution)]]]) + +(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: #export (write-one system [artifact type] package) + (-> (file.System Promise) Dependency Package (Promise (Try Any))) + (do (try.with promise.monad) + [directory (: (Promise (Try Path)) + (file.make-directories promise.monad system (//.path system artifact))) + #let [prefix (format directory (:: system separator) (//artifact.identity artifact))] + directory (: (Promise (Try (Directory Promise))) + (file.get-directory promise.monad system directory)) + _ (..write! system + (get@ #//package.library package) + (format prefix (//artifact/extension.extension type))) + _ (..write! system + (|> package + (get@ #//package.sha-1) + (:: //hash.sha-1-codec encode) + encoding.to-utf8) + (format prefix //artifact/extension.sha-1)) + _ (..write! system + (|> package + (get@ #//package.md5) + (:: //hash.md5-codec encode) + encoding.to-utf8) + (format prefix //artifact/extension.md5)) + _ (..write! system + (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8) + (format prefix //artifact/extension.pom))] + (wrap []))) + +(def: #export (write-all system resolution) + (-> (file.System Promise) Resolution (Promise (Try Any))) + (do {! (try.with promise.monad)} + [_ (monad.map ! (function (_ [dependency package]) + (..write-one system dependency package)) + (dictionary.entries resolution))] + (wrap []))) + +(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.from-utf8 + (_@map (:: codec decode)) + _@join))) + +(def: #export (read-one system [artifact type]) + (-> (file.System Promise) Dependency (Promise (Try Package))) + (let [prefix (format (//.path system artifact) + (:: system separator) + (//artifact.identity artifact))] + (do (try.with promise.monad) + [pom (..read! system (format prefix //artifact/extension.pom)) + library (..read! system (format prefix (//artifact/extension.extension type))) + sha-1 (..read! system (format prefix //artifact/extension.sha-1)) + md5 (..read! system (format prefix //artifact/extension.md5))] + (:: promise.monad wrap + (do try.monad + [pom (..decode xml.codec pom) + sha-1 (..decode //hash.sha-1-codec sha-1) + md5 (..decode //hash.md5-codec md5)] + (wrap {#//package.library library + #//package.pom pom + #//package.sha-1 sha-1 + #//package.md5 md5})))))) + +(def: #export (read-all system dependencies resolution) + (-> (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 system head))] + (with-expansions [ (as-is (read-all 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 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 2d8ffb763..2e3e464a2 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -25,6 +25,7 @@ ["#." action] ["#." command (#+ Command)] ["#." local] + ["#." cache] ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] ["#." shell] @@ -124,14 +125,14 @@ [(#.Some program) (#.Some target)] (do ///action.monad - [cache (///local.all-cached (file.async file.default) - (set.to-list (get@ #///.dependencies profile)) - ///dependency/resolution.empty) + [cache (///cache.read-all (file.async file.default) + (set.to-list (get@ #///.dependencies profile)) + ///dependency/resolution.empty) resolution (promise.future (///dependency/resolution.resolve-all (set.to-list (get@ #///.repositories profile)) (set.to-list (get@ #///.dependencies profile)) cache)) - _ (///local.cache-all (file.async file.default) + _ (///cache.write-all (file.async file.default) resolution) [resolution compiler] (promise@wrap (..compiler resolution)) working-directory (promise.future ..working-directory) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 7e48610e3..10874cbfc 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -3,6 +3,7 @@ ["." host (#+ import:)] [abstract [codec (#+ Codec)] + [equivalence (#+ Equivalence)] [monad (#+ do)]] [control ["." io (#+ IO)] @@ -133,6 +134,10 @@ Resolution (dictionary.new //.hash)) +(def: #export equivalence + (Equivalence Resolution) + (dictionary.equivalence ///package.equivalence)) + (exception: #export (cannot-resolve {dependency Dependency}) (let [artifact (get@ #//.artifact dependency) type (get@ #//.type dependency)] diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index dc769bcc1..17ddeb4cf 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -1,45 +1,12 @@ (.module: [lux #* - [abstract - ["." monad (#+ do)]] - [control - ["." io (#+ IO)] - ["." try (#+ Try)] - ["." exception] - [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]] - ["<>" parser - ["<.>" xml]]] [data - [binary (#+ Binary)] [text - ["%" format (#+ format)] - ["." encoding]] - [collection - ["." list ("#@." monoid)] - ["." dictionary] - ["." set]] - [format - ["." binary] - ["." tar] - ["." xml]]] + ["%" format (#+ format)]]] [world - ["." file (#+ Path File Directory)]]] - [program - [compositor - ["." export]]] + ["." file (#+ Path)]]] ["." // #_ - ["/" profile (#+ Profile)] - ["#." pom] - ["#." hash] - ["#." package (#+ Package)] - ["#." artifact (#+ Artifact) - ["#/." type] - ["#/." extension]] - ["#." dependency (#+ Dependency) - ["#/." resolution (#+ Resolution)]]]) + ["#." artifact (#+ Artifact)]]) (def: #export (repository system) (All [a] (-> (file.System a) Path)) @@ -51,103 +18,3 @@ (format (..repository system) (:: system separator) (//artifact.path system artifact))) - -(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]))) - -(def: #export (cache system [artifact type] package) - (-> (file.System Promise) Dependency Package (Promise (Try Any))) - (do (try.with promise.monad) - [directory (: (Promise (Try Path)) - (file.make-directories promise.monad system (..path system artifact))) - #let [prefix (format directory (:: system separator) (//artifact.identity artifact))] - directory (: (Promise (Try (Directory Promise))) - (file.get-directory promise.monad system directory)) - _ (..save! system - (get@ #//package.library package) - (format prefix (//artifact/extension.extension type))) - _ (..save! system - (|> package - (get@ #//package.sha-1) - (:: //hash.sha-1-codec encode) - encoding.to-utf8) - (format prefix //artifact/extension.sha-1)) - _ (..save! system - (|> package - (get@ #//package.md5) - (:: //hash.md5-codec encode) - encoding.to-utf8) - (format prefix //artifact/extension.md5)) - _ (..save! system - (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8) - (format prefix //artifact/extension.pom))] - (wrap []))) - -(def: #export (cache-all system resolution) - (-> (file.System Promise) Resolution (Promise (Try Any))) - (do {! (try.with promise.monad)} - [_ (monad.map ! (function (_ [dependency package]) - (..cache system dependency package)) - (dictionary.entries resolution))] - (wrap []))) - -(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: #export (cached system [artifact type]) - (-> (file.System Promise) Dependency (Promise (Try Package))) - (do (try.with promise.monad) - [directory (: (Promise (Try Path)) - (file.make-directories promise.monad system (..path system artifact))) - #let [prefix (format directory (:: system separator) (//artifact.identity artifact))] - pom (..read! system (format prefix //artifact/extension.pom)) - library (..read! system (format prefix (//artifact/extension.extension type))) - sha-1 (..read! system (format prefix //artifact/extension.sha-1)) - md5 (..read! system (format prefix //artifact/extension.md5))] - (:: promise.monad wrap - (do try.monad - [pom (encoding.from-utf8 pom) - pom (:: xml.codec decode pom) - sha-1 (//hash.as-sha-1 sha-1) - md5 (//hash.as-md5 md5)] - (wrap {#//package.library library - #//package.pom pom - #//package.sha-1 sha-1 - #//package.md5 md5}))))) - -(def: #export (all-cached system dependencies resolution) - (-> (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 - (..cached system head))] - (with-expansions [ (as-is (all-cached 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) - (all-cached system (set.to-list sub-dependencies)))] - ) - - (#try.Failure error) - ))))) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 757f116e6..31376c6f5 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -1,13 +1,15 @@ (.module: [lux #* + [abstract + ["." equivalence (#+ Equivalence)]] [control ["." try (#+ Try) ("#@." functor)] [parser ["<.>" xml]]] [data - [binary (#+ Binary)] + ["." binary (#+ Binary)] [format - [xml (#+ XML)]] + ["." xml (#+ XML)]] [collection [set (#+ Set)]]]] ["." // #_ @@ -34,3 +36,12 @@ (|>> (get@ #pom) (.run //pom.parser) (try@map (get@ #/.dependencies)))) + +(def: #export equivalence + (Equivalence Package) + ($_ equivalence.product + binary.equivalence + xml.equivalence + //hash.equivalence + //hash.equivalence + )) -- cgit v1.2.3