From d89d837de3475b75587a4293e094d755d2cd4626 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 17 Nov 2020 20:23:53 -0400 Subject: Made the syntax of ^template more consistent. --- stdlib/source/program/aedifex/cache.lux | 25 ++-- stdlib/source/program/aedifex/command/build.lux | 9 +- stdlib/source/program/aedifex/command/deploy.lux | 3 +- stdlib/source/program/aedifex/command/deps.lux | 37 ++++++ .../program/aedifex/dependency/resolution.lux | 139 ++++++++------------- stdlib/source/program/aedifex/hash.lux | 10 +- stdlib/source/program/aedifex/package.lux | 32 ++++- stdlib/source/program/aedifex/profile.lux | 4 +- stdlib/source/program/aedifex/repository.lux | 43 +++++-- 9 files changed, 182 insertions(+), 120 deletions(-) create mode 100644 stdlib/source/program/aedifex/command/deps.lux (limited to 'stdlib/source/program/aedifex') diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index 2a81b2869..ef72dc988 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -11,12 +11,14 @@ ["!" capability]]] [data [binary (#+ Binary)] + ["." product] [text ["%" format (#+ format)] ["." encoding]] [collection ["." dictionary] - ["." set]] + ["." set (#+ Set)] + ["." list]] [format ["." xml]]] [world @@ -25,7 +27,7 @@ ["#" local] ["#." hash] ["#." package (#+ Package)] - ["#." artifact + ["#." artifact (#+ Artifact) ["#/." extension]] [dependency (#+ Dependency) [resolution (#+ Resolution)]]]) @@ -38,7 +40,7 @@ (!.use (:: file over-write) [content]))) (def: #export (write-one system [artifact type] package) - (-> (file.System Promise) Dependency Package (Promise (Try Any))) + (-> (file.System Promise) Dependency Package (Promise (Try Artifact))) (do (try.with promise.monad) [directory (: (Promise (Try Path)) (file.make-directories promise.monad system (//.path system artifact))) @@ -63,15 +65,17 @@ _ (..write! system (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8) (format prefix //artifact/extension.pom))] - (wrap []))) + (wrap artifact))) (def: #export (write-all system resolution) - (-> (file.System Promise) Resolution (Promise (Try Any))) + (-> (file.System Promise) Resolution (Promise (Try (Set Artifact)))) (do {! (try.with promise.monad)} - [_ (monad.map ! (function (_ [dependency package]) - (..write-one system dependency package)) - (dictionary.entries resolution))] - (wrap []))) + [] + (|> (dictionary.entries resolution) + (list.filter (|>> product.right //package.local?)) + (monad.map ! (function (_ [dependency package]) + (..write-one system dependency package))) + (:: ! map (set.from-list //artifact.hash))))) (def: (read! system path) (-> (file.System Promise) Path (Promise (Try Binary))) @@ -103,7 +107,8 @@ [pom (..decode xml.codec pom) sha-1 (..decode //hash.sha-1-codec sha-1) md5 (..decode //hash.md5-codec md5)] - (wrap {#//package.library library + (wrap {#//package.origin #//package.Local + #//package.library library #//package.pom pom #//package.sha-1 sha-1 #//package.md5 md5})))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 2e3e464a2..623a20841 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -26,6 +26,7 @@ ["#." command (#+ Command)] ["#." local] ["#." cache] + ["#." repository] ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] ["#." shell] @@ -128,10 +129,10 @@ [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)) + resolution (///dependency/resolution.all (list@map (|>> ///repository.remote ///repository.async) + (set.to-list (get@ #///.repositories profile))) + (set.to-list (get@ #///.dependencies profile)) + cache) _ (///cache.write-all (file.async file.default) resolution) [resolution compiler] (promise@wrap (..compiler resolution)) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index a083d8f53..37a5a0f40 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -44,5 +44,6 @@ _ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) _ (deploy! ///artifact/extension.lux-library library) _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library))) - _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))] + _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library))) + #let [_ (log! "Successfully deployed!")]] (wrap [])))) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux new file mode 100644 index 000000000..91bbf0ec1 --- /dev/null +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -0,0 +1,37 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + [concurrency + ["." promise]]] + [data + [collection + ["." set (#+ Set)] + ["." list ("#\." functor)]]] + [world + ["." file]]] + ["." /// #_ + [command (#+ Command)] + [artifact (#+ Artifact)] + ["#" profile] + ["#." action (#+ Action)] + ["#." cache] + ["#." repository] + ["#." dependency #_ + ["#" resolution]]]) + +(def: #export (do! profile) + (Command (Set Artifact)) + (do ///action.monad + [cache (///cache.read-all (file.async file.default) + (set.to-list (get@ #///.dependencies profile)) + ///dependency.empty) + resolution (///dependency.all (list\map (|>> ///repository.remote ///repository.async) + (set.to-list (get@ #///.repositories profile))) + (set.to-list (get@ #///.dependencies profile)) + cache) + cached (///cache.write-all (file.async file.default) + resolution) + #let [_ (log! "Successfully resolved dependencies!")]] + (wrap cached))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 2c6a9b5e6..8becf87dd 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -4,13 +4,14 @@ [abstract [codec (#+ Codec)] [equivalence (#+ Equivalence)] - [monad (#+ do)]] + [monad (#+ Monad do)]] [control - ["." io (#+ IO)] ["." try (#+ Try)] ["." exception (#+ Exception exception:)] ["<>" parser - ["<.>" xml (#+ Parser)]]] + ["<.>" xml (#+ Parser)]] + [concurrency + ["." promise (#+ Promise)]]] [data ["." binary (#+ Binary)] ["." name] @@ -32,98 +33,60 @@ ["." // (#+ Dependency) ["/#" // #_ ["/" profile] - ["#." repository (#+ Address)] + ["#." repository (#+ Address Repository)] ["#." hash] ["#." pom] ["#." package (#+ Package)] - ["#." 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))))))))) + ["#." artifact (#+ Artifact) + ["#/." extension (#+ Extension)]]]]) (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)])))] + (exception.report + ["Artifact" (///artifact.format (get@ #//.artifact dependency))] + ["Type" (%.text (get@ #//.type dependency))] + ["Hash" (%.text hash)]))] [sha-1-does-not-match] [md5-does-not-match] ) -(def: (verified-hash dependency library url hash codec exception) +(def: (verified-hash dependency library repository artifact extension hash codec exception) (All [h] - (-> Dependency Binary URL + (-> Dependency Binary (Repository Promise) Artifact Extension (-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h)) (Exception [Dependency Text]) - (IO (Try (///hash.Hash h))))) - (do (try.with io.monad) - [#let [expected (hash library)] - actual (..download url)] - (:: io.monad wrap + (Promise (Try (///hash.Hash h))))) + (do (try.with promise.monad) + [actual (:: repository download artifact extension)] + (:: promise.monad wrap (do try.monad [output (encoding.from-utf8 actual) actual (:: codec decode output) _ (exception.assert exception [dependency output] - (:: ///hash.equivalence = expected actual))] + (:: ///hash.equivalence = (hash library) actual))] (wrap actual))))) -(def: #export (resolve repository dependency) - (-> Address Dependency (IO (Try Package))) +(def: #export (one repository dependency) + (-> (Repository Promise) Dependency (Promise (Try Package))) (let [[artifact type] dependency - prefix (format repository uri.separator (///artifact.uri artifact))] - (do (try.with io.monad) - [library (..download (format prefix (///artifact/extension.extension type))) - sha-1 (..verified-hash dependency library (format prefix ///artifact/extension.sha-1) ///hash.sha-1 ///hash.sha-1-codec ..sha-1-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 + extension (///artifact/extension.extension type)] + (do (try.with promise.monad) + [library (:: repository download artifact extension) + sha-1 (..verified-hash dependency library + repository artifact ///artifact/extension.sha-1 + ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match) + md5 (..verified-hash dependency library + repository artifact ///artifact/extension.md5 + ///hash.md5 ///hash.md5-codec ..md5-does-not-match) + pom (:: repository download artifact ///artifact/extension.pom)] + (:: promise.monad wrap (do try.monad [pom (encoding.from-utf8 pom) pom (:: xml.codec decode pom) profile (.run ///pom.parser pom)] - (wrap {#///package.library library + (wrap {#///package.origin #///package.Remote + #///package.library library #///package.pom pom #///package.sha-1 sha-1 #///package.md5 md5})))))) @@ -140,46 +103,44 @@ (dictionary.equivalence ///package.equivalence)) (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)]))) + (exception.report + ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))] + ["Type" (%.text (get@ #//.type dependency))])) -(def: (resolve-any repositories dependency) - (-> (List Address) Dependency (IO (Try Package))) +(def: (any repositories dependency) + (-> (List (Repository Promise)) Dependency (Promise (Try Package))) (case repositories #.Nil (|> dependency (exception.throw ..cannot-resolve) - (:: io.monad wrap)) + (:: promise.monad wrap)) (#.Cons repository alternatives) - (do io.monad - [outcome (..resolve repository dependency)] + (do promise.monad + [outcome (..one repository dependency)] (case outcome (#try.Success package) (wrap outcome) (#try.Failure error) - (resolve-any alternatives dependency))))) + (any alternatives dependency))))) -(def: #export (resolve-all repositories dependencies resolution) - (-> (List Address) (List Dependency) Resolution (IO (Try Resolution))) +(def: #export (all repositories dependencies resolution) + (-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution))) (case dependencies #.Nil - (:: (try.with io.monad) wrap resolution) + (:: (try.with promise.monad) wrap resolution) (#.Cons head tail) - (do (try.with io.monad) + (do (try.with promise.monad) [package (case (dictionary.get head resolution) (#.Some package) (wrap package) #.None - (..resolve-any repositories head)) - sub-dependencies (:: io.monad wrap (///package.dependencies package)) + (..any repositories head)) + sub-dependencies (:: promise.monad wrap (///package.dependencies package)) resolution (|> resolution (dictionary.put head package) - (resolve-all repositories (set.to-list sub-dependencies)))] - (resolve-all repositories tail resolution)))) + (all repositories (set.to-list sub-dependencies)))] + (all repositories tail resolution)))) diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index e5e4e020f..35e3f17a8 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -131,11 +131,11 @@ (case (..hash-size input) 0 (constructor output) (^template [ ] - - (do try.monad - [head (:: n.hex decode input) - output ( index head output)] - (constructor output))) + [ + (do try.monad + [head (:: n.hex decode input) + output ( index head output)] + (constructor output))]) ([1 binary.write/8] [2 binary.write/16] [4 binary.write/32]) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 31376c6f5..11d073b51 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -18,15 +18,42 @@ ["#." hash (#+ Hash SHA-1 MD5)] ["#." pom]]) +(type: #export Origin + #Local + #Remote) + +(structure: any-equivalence + (Equivalence Any) + + (def: (= _ _) + true)) + +(def: origin-equivalence + (Equivalence Origin) + ($_ equivalence.sum + ..any-equivalence + ..any-equivalence)) + (type: #export Package - {#library Binary + {#origin Origin + #library Binary #pom XML #sha-1 (Hash SHA-1) #md5 (Hash MD5)}) +(template [ ] + [(def: #export + (-> Package Bit) + (|>> (get@ #origin) (:: ..origin-equivalence = )))] + + [local? #Local] + [remote? #Remote] + ) + (def: #export (local pom library) (-> XML Binary Package) - {#library library + {#origin #Local + #library library #pom pom #sha-1 (//hash.sha-1 library) #md5 (//hash.md5 library)}) @@ -40,6 +67,7 @@ (def: #export equivalence (Equivalence Package) ($_ equivalence.product + ..origin-equivalence binary.equivalence xml.equivalence //hash.equivalence diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 8b5ea26b6..e165c9e3b 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -35,8 +35,8 @@ (def: (= reference subject) (case [reference subject] (^template [] - [ ] - true) + [[ ] + true]) ([#Repo] [#Manual]) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index 0c8f92993..5c622d84b 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -11,10 +11,12 @@ ["." promise (#+ Promise)] ["." stm]]] [data - [binary (#+ Binary)] + ["." binary (#+ Binary)] ["." text ["%" format (#+ format)] - ["." encoding]]] + ["." encoding]] + [number + ["n" nat]]] [world [net (#+ URL) ["." uri]]]] @@ -90,6 +92,8 @@ (wrap (#try.Failure error)))))) ))) +(import: java/lang/String) + (import: java/lang/AutoCloseable (close [] #io #try void)) @@ -97,8 +101,6 @@ (flush [] #io #try void) (write [[byte]] #io #try void)) -(import: java/lang/String) - (import: java/net/URLConnection (setDoOutput [boolean] #io #try void) (setRequestProperty [java/lang/String java/lang/String] #io #try void) @@ -110,7 +112,8 @@ (import: java/net/URL (new [java/lang/String]) - (openConnection [] #io #try java/net/URLConnection)) + (openConnection [] #io #try java/net/URLConnection) + (openStream [] #io #try java/io/InputStream)) (import: java/util/Base64$Encoder (encodeToString [[byte]] java/lang/String)) @@ -118,6 +121,12 @@ (import: java/util/Base64 (#static getEncoder [] java/util/Base64$Encoder)) +(import: java/io/InputStream) + +(import: java/io/BufferedInputStream + (new [java/io/InputStream]) + (read [[byte] int int] #io #try int)) + (exception: #export (failure {code Int}) (exception.report ["Code" (%.int code)])) @@ -131,11 +140,31 @@ (-> Address Artifact Extension URL) (format address uri.separator (//artifact.uri artifact) extension)) -(structure: #export (default address) +(def: buffer-size + (n.* 512 1,024)) + +(structure: #export (remote address) (All [s] (-> Address (Repository IO))) (def: (download artifact extension) - (io.io (#try.Failure "YOLO"))) + (let [url (..url address artifact extension)] + (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)))))))))) (def: (upload [user password] artifact extension content) (do (try.with io.monad) -- cgit v1.2.3