aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex.lux10
-rw-r--r--stdlib/source/program/aedifex/cache.lux138
-rw-r--r--stdlib/source/program/aedifex/command/build.lux9
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux5
-rw-r--r--stdlib/source/program/aedifex/local.lux139
-rw-r--r--stdlib/source/program/aedifex/package.lux15
6 files changed, 169 insertions, 147 deletions
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 [<next> (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)))]
+ <next>)
+
+ (#try.Failure error)
+ <next>)))))
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 [<next> (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)))]
- <next>)
-
- (#try.Failure error)
- <next>)))))
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)
(<xml>.run //pom.parser)
(try@map (get@ #/.dependencies))))
+
+(def: #export equivalence
+ (Equivalence Package)
+ ($_ equivalence.product
+ binary.equivalence
+ xml.equivalence
+ //hash.equivalence
+ //hash.equivalence
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 14:32:39 +0000