(.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 [] [(exception: #export ( {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 (.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))))