blob: 674d99f0465663b747293287d4ed96c02fe6f85d (
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
|
(.module:
[lux #*
[abstract
["." monad (#+ do)]]
[control
["." io (#+ IO)]
["." try (#+ Try)]
["." exception]
[concurrency
["." promise (#+ Promise)]]
[security
["!" capability]]
["<>" parser
["<.>" xml]]]
[data
[binary (#+ Binary)]
["." text
["%" format (#+ format)]
["." encoding]]
[collection
["." list ("#@." monoid)]
["." dictionary]
["." set]]
[format
["." binary]
["." tar]
["." xml]]]
[world
["." file (#+ Path File Directory)]
[net
["." uri]]]]
[program
[compositor
["." export]]]
["." // #_
["/" profile (#+ Profile)]
["#." pom]
["#." hash]
["#." artifact (#+ Artifact)
["#/." type]
["#/." extension]]
["#." dependency (#+ Dependency)
["#/." resolution (#+ Package Resolution)]]])
(def: (repository system)
(All [a] (-> (file.System a) Path))
(let [/ (:: system separator)]
(format "~" / ".m2" / "repository")))
(def: #export (path system artifact)
(All [a] (-> (file.System a) Artifact Path))
(format (..repository system)
(:: system separator)
(text.replace-all uri.separator (:: system separator)
(//artifact.path artifact))))
(def: (save! system content file)
(-> (file.System Promise) Binary Path (Promise (Try Any)))
(do (try.with promise.monad)
[file (: (Promise (Try (File Promise)))
(file.get-file promise.monad system file))]
(!.use (:: file over-write) [content])))
(def: #export (install system profile)
(-> (file.System Promise) Profile (Promise (Try Any)))
(case (get@ #/.identity profile)
(#.Some identity)
(do (try.with promise.monad)
[repository (: (Promise (Try Path))
(file.make-directories promise.monad system (..path system identity)))
#let [artifact-name (format repository (:: system separator) (//artifact.identity identity))]
package (export.library system (set.to-list (get@ #/.sources profile)))
_ (..save! system (binary.run tar.writer package)
(format artifact-name //artifact/extension.lux-library))
pom (:: promise.monad wrap (//pom.write profile))]
(..save! system (|> pom (:: xml.codec encode) encoding.to-utf8)
(format artifact-name //artifact/extension.pom)))
_
(:: promise.monad wrap (exception.throw /.no-identity []))))
(def: #export (cache system [artifact type] package)
(-> (file.System Promise) Dependency Package (Promise (Try Any)))
(do (try.with promise.monad)
[directory (: (Promise (Try Path))
(file.make-directories promise.monad system (..path system artifact)))
#let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
directory (: (Promise (Try (Directory Promise)))
(file.get-directory promise.monad system directory))
_ (..save! system
(get@ #//dependency/resolution.library package)
(format prefix (//artifact/extension.extension type)))
_ (..save! system
(encoding.to-utf8 (get@ #//dependency/resolution.sha1 package))
(format prefix //artifact/extension.sha1))
_ (..save! system
(encoding.to-utf8 (get@ #//dependency/resolution.md5 package))
(format prefix //artifact/extension.md5))
_ (..save! system
(|> package (get@ #//dependency/resolution.pom) (:: xml.codec encode) encoding.to-utf8)
(format prefix //artifact/extension.pom))]
(wrap [])))
(def: #export (cache-all system resolution)
(-> (file.System Promise) Resolution (Promise (Try Any)))
(do {@ (try.with promise.monad)}
[_ (monad.map @ (function (_ [dependency package])
(..cache system dependency package))
(dictionary.entries resolution))]
(wrap [])))
(def: (read! system path)
(-> (file.System Promise) Path (Promise (Try Binary)))
(do (try.with promise.monad)
[file (: (Promise (Try (File Promise)))
(!.use (:: system file) path))]
(!.use (:: file content) [])))
(def: #export (cached system [artifact type])
(-> (file.System Promise) Dependency (Promise (Try Package)))
(do (try.with promise.monad)
[directory (: (Promise (Try Path))
(file.make-directories promise.monad system (..path system artifact)))
#let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
pom (..read! system (format prefix //artifact/extension.pom))
[pom dependencies] (:: promise.monad wrap
(do try.monad
[pom (encoding.from-utf8 pom)
pom (:: xml.codec decode pom)
profile (<xml>.run //pom.parser pom)]
(wrap [pom (get@ #/.dependencies profile)])))
library (..read! system (format prefix (//artifact/extension.extension type)))
sha1 (..read! system (format prefix //artifact/extension.sha1))
md5 (..read! system (format prefix //artifact/extension.md5))]
(wrap {#//dependency/resolution.library library
#//dependency/resolution.pom pom
#//dependency/resolution.dependencies (set.to-list dependencies)
#//dependency/resolution.sha1 (|> sha1
(:coerce (//hash.Hash //hash.SHA-1))
(:: //hash.sha1-codec encode))
#//dependency/resolution.md5 (|> md5
(:coerce (//hash.Hash //hash.MD5))
(:: //hash.md5-codec encode))})))
(def: #export (all-cached system dependencies resolution)
(-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
(case dependencies
#.Nil
(:: (try.with promise.monad) wrap resolution)
(#.Cons head tail)
(do promise.monad
[package (case (dictionary.get head resolution)
(#.Some package)
(wrap (#try.Success package))
#.None
(..cached system head))]
(with-expansions [<next> (as-is (all-cached system tail resolution))]
(case package
(#try.Success package)
(let [resolution (dictionary.put head package resolution)]
(do (try.with promise.monad)
[resolution (all-cached system (get@ #//dependency/resolution.dependencies package) resolution)]
<next>))
(#try.Failure error)
<next>)))))
|
