Re-named "search" to "one" and "search-all" to "all".

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))))