blob: d6a8a70efa93ec05076525c37750bd50c855830c (
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
|
(.module:
[lux #*
[abstract
[codec (#+ Codec)]
["." monad (#+ do)]]
[control
["." try (#+ Try)]
[concurrency
["." promise (#+ Promise)]]
[security
["!" capability]]]
[data
[binary (#+ Binary)]
["." product]
[text
["%" format (#+ format)]
["." encoding]]
[collection
["." dictionary]
["." set (#+ Set)]
["." list]]
[format
["." xml]]]
[world
[program (#+ Program)]
["." file (#+ Path File Directory)]]]
["." // #_
["#" local]
["#." hash]
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." extension]]
[dependency (#+ Dependency)
[resolution (#+ Resolution)]]])
(def: (write! 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 (write-one program system [artifact type] package)
(-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
(do promise.monad
[home (\ program home [])]
(do (try.with promise.monad)
[directory (: (Promise (Try Path))
(file.make-directories promise.monad system (//.path system home artifact)))
#let [prefix (format directory (\ system separator) (//artifact.identity artifact))]
directory (: (Promise (Try (Directory Promise)))
(file.get-directory promise.monad system directory))
_ (..write! system
(get@ #//package.library package)
(format prefix (//artifact/extension.extension type)))
_ (..write! system
(|> package
(get@ #//package.sha-1)
(\ //hash.sha-1-codec encode)
encoding.to-utf8)
(format prefix //artifact/extension.sha-1))
_ (..write! system
(|> package
(get@ #//package.md5)
(\ //hash.md5-codec encode)
encoding.to-utf8)
(format prefix //artifact/extension.md5))
_ (..write! system
(|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8)
(format prefix //artifact/extension.pom))]
(wrap artifact))))
(def: #export (write-all program system resolution)
(-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact))))
(do {! (try.with promise.monad)}
[]
(|> (dictionary.entries resolution)
(list.filter (|>> product.right //package.local? not))
(monad.map ! (function (_ [dependency package])
(..write-one program system dependency package)))
(\ ! map (set.from-list //artifact.hash)))))
(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: (decode codec data)
(All [a] (-> (Codec Text a) Binary (Try a)))
(let [(^open "_\.") try.monad]
(|> data
encoding.from-utf8
(_\map (\ codec decode))
_\join)))
(def: #export (read-one program system [artifact type])
(-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package)))
(do promise.monad
[home (\ program home [])
#let [prefix (format (//.path system home artifact)
(\ system separator)
(//artifact.identity artifact))]]
(do (try.with promise.monad)
[pom (..read! system (format prefix //artifact/extension.pom))
library (..read! system (format prefix (//artifact/extension.extension type)))
sha-1 (..read! system (format prefix //artifact/extension.sha-1))
md5 (..read! system (format prefix //artifact/extension.md5))]
(\ promise.monad wrap
(do try.monad
[pom (..decode xml.codec pom)
sha-1 (..decode //hash.sha-1-codec sha-1)
md5 (..decode //hash.md5-codec md5)]
(wrap {#//package.origin #//package.Local
#//package.library library
#//package.pom pom
#//package.sha-1 sha-1
#//package.md5 md5}))))))
(def: #export (read-all program system dependencies resolution)
(-> (Program Promise) (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
(..read-one program system head))]
(with-expansions [<next> (as-is (read-all program system tail resolution))]
(case package
(#try.Success package)
(do (try.with promise.monad)
[sub-dependencies (|> package
//package.dependencies
(\ promise.monad wrap))
resolution (|> resolution
(dictionary.put head package)
(read-all program system (set.to-list sub-dependencies)))]
<next>)
(#try.Failure error)
<next>)))))
|
