blob: e6b24b1527f05fba284bf18cd946a781c9513d6e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
(.module:
[lux (#- Name)
["." host (#+ import:)]
[abstract
[codec (#+ Codec)]
[equivalence (#+ Equivalence)]
[monad (#+ Monad do)]]
[control
["." try (#+ Try)]
["." exception (#+ Exception exception:)]
["<>" parser
["<.>" xml (#+ Parser)]]
[concurrency
["." promise (#+ Promise)]]]
[data
["." binary (#+ Binary)]
["." name]
["." maybe]
[text
["%" format (#+ format)]
["." encoding]]
[format
["." xml (#+ Tag XML)]]
[collection
["." dictionary (#+ Dictionary)]
["." set]]]
[math
[number
["n" nat]
["." i64]]]
[world
[net (#+ URL)
["." uri]]]]
["." // (#+ Dependency)
["#." status (#+ Status)]
["/#" // #_
["/" profile]
["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." extension (#+ Extension)]]
["#." repository (#+ Repository)
["#/." remote (#+ Address)]
["#/." origin (#+ Origin)]]]])
(template [<name>]
[(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
(exception.report
["Artifact" (///artifact.format artifact)]
["Extension" (%.text extension)]
["Hash" (%.text hash)]))]
[sha-1_does_not_match]
[md5_does_not_match]
)
(def: (verified_hash library repository artifact extension hash codec exception)
(All [h]
(-> Binary (Repository Promise) Artifact Extension
(-> Binary (Hash h)) (Codec Text (Hash h))
(Exception [Artifact Extension Text])
(Promise (Try (Maybe (Hash h))))))
(do promise.monad
[?actual (\ repository download (///repository/remote.uri artifact extension))]
(case ?actual
(#try.Success actual)
(wrap (do try.monad
[output (\ encoding.utf8 decode actual)
actual (\ codec decode output)
_ (exception.assert exception [artifact extension output]
(\ ///hash.equivalence = (hash library) actual))]
(wrap (#.Some actual))))
(#try.Failure error)
(wrap (#try.Success #.None)))))
(def: (hashed repository artifact extension)
(-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
(do (try.with promise.monad)
[data (\ repository download (///repository/remote.uri artifact extension))
?sha-1 (..verified_hash data
repository artifact (format extension ///artifact/extension.sha-1)
///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match)
?md5 (..verified_hash data
repository artifact (format extension ///artifact/extension.md5)
///hash.md5 ///hash.md5_codec ..md5_does_not_match)]
(wrap [data (case [?sha-1 ?md5]
[(#.Some sha-1) (#.Some md5)]
(#//status.Verified sha-1 md5)
[(#.Some sha-1) _]
(#//status.Partial (#.Left sha-1))
[_ (#.Some md5)]
(#//status.Partial (#.Right md5))
[#.None #.None]
#//status.Unverified)])))
(def: #export (one repository dependency)
(-> (Repository Promise) Dependency (Promise (Try Package)))
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
[[pom pom_status] (..hashed repository artifact ///artifact/extension.pom)
library_&_status (..hashed repository artifact extension)]
(\ promise.monad wrap
(do try.monad
[pom (\ encoding.utf8 decode pom)
pom (\ xml.codec decode pom)
profile (<xml>.run ///pom.parser pom)]
(wrap {#///package.origin (#///repository/origin.Remote "")
#///package.library library_&_status
#///package.pom [pom pom_status]}))))))
(type: #export Resolution
(Dictionary Dependency Package))
(def: #export empty
Resolution
(dictionary.new //.hash))
(def: #export equivalence
(Equivalence Resolution)
(dictionary.equivalence ///package.equivalence))
(exception: #export (cannot_resolve {dependency Dependency})
(exception.report
["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))]
["Type" (%.text (get@ #//.type dependency))]))
(def: #export (any repositories dependency)
(-> (List (Repository Promise)) Dependency (Promise (Try Package)))
(case repositories
#.Nil
(|> dependency
(exception.throw ..cannot_resolve)
(\ promise.monad wrap))
(#.Cons repository alternatives)
(do promise.monad
[outcome (..one repository dependency)]
(case outcome
(#try.Success package)
(wrap outcome)
(#try.Failure error)
(any alternatives dependency)))))
(def: #export (all repositories dependencies resolution)
(-> (List (Repository Promise)) (List Dependency) Resolution (Promise (Try Resolution)))
(case dependencies
#.Nil
(\ (try.with promise.monad) wrap resolution)
(#.Cons head tail)
(do (try.with promise.monad)
[package (case (dictionary.get head resolution)
(#.Some package)
(wrap package)
#.None
(..any repositories head))
sub_dependencies (\ promise.monad wrap (///package.dependencies package))
resolution (|> resolution
(dictionary.put head package)
(all repositories (set.to_list sub_dependencies)))]
(all repositories tail resolution))))
|
