aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/dependency
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program/aedifex/dependency')
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux184
1 files changed, 184 insertions, 0 deletions
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
new file mode 100644
index 000000000..57df92d2a
--- /dev/null
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -0,0 +1,184 @@
+(.module:
+ [lux (#- Name)
+ ["." host (#+ import:)]
+ [abstract
+ [codec (#+ Codec)]
+ [monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try (#+ Try)]
+ ["." exception (#+ Exception exception:)]
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." name]
+ ["." maybe]
+ [text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [number
+ ["." i64]
+ ["n" nat]]
+ [format
+ ["." xml (#+ Tag XML)]]
+ [collection
+ ["." dictionary (#+ Dictionary)]
+ ["." set]]]
+ [world
+ [net (#+ URL)
+ ["." uri]]]]
+ ["." // (#+ Repository Dependency)
+ ["/#" // #_
+ ["/" profile]
+ ["#." hash]
+ ["#." pom]
+ ["#." artifact
+ ["#/." extension]]]])
+
+(import: java/lang/String)
+
+(import: java/lang/AutoCloseable
+ (close [] #io #try void))
+
+(import: java/io/InputStream)
+
+(import: java/net/URL
+ (new [java/lang/String])
+ (openStream [] #io #try java/io/InputStream))
+
+(import: java/io/BufferedInputStream
+ (new [java/io/InputStream])
+ (read [[byte] int int] #io #try int))
+
+(def: buffer-size
+ (n.* 512 1,024))
+
+(def: (download url)
+ (-> URL (IO (Try Binary)))
+ (do {@ (try.with io.monad)}
+ [input (|> (java/net/URL::new url)
+ java/net/URL::openStream
+ (:: @ map (|>> java/io/BufferedInputStream::new)))
+ #let [buffer (binary.create ..buffer-size)]]
+ (loop [output (:: binary.monoid identity)]
+ (do @
+ [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
+ (case bytes-read
+ -1 (do @
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ _ (if (n.= ..buffer-size bytes-read)
+ (recur (:: binary.monoid compose output buffer))
+ (do @
+ [chunk (:: io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
+ (recur (:: binary.monoid compose output chunk)))))))))
+
+(template [<name>]
+ [(exception: #export (<name> {dependency Dependency} {hash Text})
+ (let [artifact (get@ #//.artifact dependency)
+ type (get@ #//.type dependency)]
+ (exception.report
+ ["Artifact" (format (get@ #///artifact.group artifact)
+ " " (get@ #///artifact.name artifact)
+ " " (get@ #///artifact.version artifact))]
+ ["Type" (%.text type)]
+ ["Hash" (%.text hash)])))]
+
+ [sha1-does-not-match]
+ [md5-does-not-match]
+ )
+
+(type: #export Package
+ {#library Binary
+ #pom XML
+ #dependencies (List Dependency)
+ #sha1 Text
+ #md5 Text})
+
+(def: (verified-hash dependency library url hash codec exception)
+ (All [h]
+ (-> Dependency Binary URL
+ (-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
+ (Exception [Dependency Text])
+ (IO (Try Text))))
+ (do (try.with io.monad)
+ [#let [expected (hash library)]
+ actual (..download url)]
+ (:: io.monad wrap
+ (do try.monad
+ [output (encoding.from-utf8 actual)
+ actual (:: codec decode output)
+ _ (exception.assert exception [dependency output]
+ (:: ///hash.equivalence = expected actual))]
+ (wrap output)))))
+
+(def: #export (resolve repository dependency)
+ (-> Repository Dependency (IO (Try Package)))
+ (let [[artifact type] dependency
+ prefix (format repository uri.separator (///artifact.path artifact))]
+ (do (try.with io.monad)
+ [library (..download (format prefix (///artifact/extension.extension type)))
+ sha1 (..verified-hash dependency library (format prefix ///artifact/extension.sha1) ///hash.sha1 ///hash.sha1-codec ..sha1-does-not-match)
+ md5 (..verified-hash dependency library (format prefix ///artifact/extension.md5) ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
+ pom (..download (format prefix ///artifact/extension.pom))]
+ (:: io.monad wrap
+ (do try.monad
+ [pom (encoding.from-utf8 pom)
+ pom (:: xml.codec decode pom)
+ profile (<xml>.run ///pom.parser pom)]
+ (wrap {#library library
+ #pom pom
+ #dependencies (set.to-list (get@ #/.dependencies profile))
+ #sha1 sha1
+ #md5 md5}))))))
+
+(type: #export Resolution
+ (Dictionary Dependency Package))
+
+(def: #export empty
+ Resolution
+ (dictionary.new //.hash))
+
+(exception: #export (cannot-resolve {dependency Dependency})
+ (let [artifact (get@ #//.artifact dependency)
+ type (get@ #//.type dependency)]
+ (exception.report
+ ["Artifact" (%.text (///artifact.format artifact))]
+ ["Type" (%.text type)])))
+
+(def: (resolve-any repositories dependency)
+ (-> (List Repository) Dependency (IO (Try Package)))
+ (case repositories
+ #.Nil
+ (|> dependency
+ (exception.throw ..cannot-resolve)
+ (:: io.monad wrap))
+
+ (#.Cons repository alternatives)
+ (do io.monad
+ [outcome (..resolve repository dependency)]
+ (case outcome
+ (#try.Success package)
+ (wrap outcome)
+
+ (#try.Failure error)
+ (resolve-any alternatives dependency)))))
+
+(def: #export (resolve-all repositories dependencies resolution)
+ (-> (List Repository) (List Dependency) Resolution (IO (Try Resolution)))
+ (case dependencies
+ #.Nil
+ (:: (try.with io.monad) wrap resolution)
+
+ (#.Cons head tail)
+ (do (try.with io.monad)
+ [package (case (dictionary.get head resolution)
+ (#.Some package)
+ (wrap package)
+
+ #.None
+ (..resolve-any repositories head))
+ #let [resolution (dictionary.put head package resolution)]
+ resolution (resolve-all repositories (get@ #dependencies package) resolution)]
+ (resolve-all repositories tail resolution))))