blob: e42b2d2c51436159c66253505969c06f449af758 (
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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
(.module:
[library
[lux (#- Module)
[abstract
["." equivalence (#+ Equivalence)]
["." monad (#+ do)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]
["." function]
["<>" parser
["<.>" binary (#+ Parser)]]]
[data
[binary (#+ Binary)]
["." bit]
["." product]
["." name]
["." text
["%" format (#+ format)]]
[format
["." binary (#+ Writer)]]
[collection
["." list ("#\." functor fold)]
["." dictionary (#+ Dictionary)]
["." set]
["." row (#+ Row)]]]
[math
[number
["n" nat ("#\." equivalence)]]]
[type
abstract]]]
[/
["." artifact]
["." signature (#+ Signature)]
["." key (#+ Key)]
["." descriptor (#+ Module Descriptor)]
["." document (#+ Document)]
[///
[version (#+ Version)]]])
(type: .public Output
(Row [artifact.ID (Maybe Text) Binary]))
(exception: .public (unknown_document {module Module}
{known_modules (List Module)})
(exception.report
["Module" (%.text module)]
["Known Modules" (exception.listing %.text known_modules)]))
(exception: .public (cannot_replace_document {module Module}
{old (Document Any)}
{new (Document Any)})
(exception.report
["Module" (%.text module)]
["Old key" (signature.description (document.signature old))]
["New key" (signature.description (document.signature new))]))
(exception: .public (module_has_already_been_reserved {module Module})
(exception.report
["Module" (%.text module)]))
(exception: .public (module_must_be_reserved_before_it_can_be_added {module Module})
(exception.report
["Module" (%.text module)]))
(exception: .public (module_is_only_reserved {module Module})
(exception.report
["Module" (%.text module)]))
(type: .public ID
Nat)
(def: .public runtime_module
Module
"")
(abstract: .public Archive
{}
{#next ID
#resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])}
(def: next
(-> Archive ID)
(|>> :representation (get@ #next)))
(def: .public empty
Archive
(:abstraction {#next 0
#resolver (dictionary.empty text.hash)}))
(def: .public (id module archive)
(-> Module Archive (Try ID))
(let [(^slots [#..resolver]) (:representation archive)]
(case (dictionary.get module resolver)
(#.Some [id _])
(#try.Success id)
#.None
(exception.except ..unknown_document [module
(dictionary.keys resolver)]))))
(def: .public (reserve module archive)
(-> Module Archive (Try [ID Archive]))
(let [(^slots [#..next #..resolver]) (:representation archive)]
(case (dictionary.get module resolver)
(#.Some _)
(exception.except ..module_has_already_been_reserved [module])
#.None
(#try.Success [next
(|> archive
:representation
(update@ #..resolver (dictionary.put module [next #.None]))
(update@ #..next inc)
:abstraction)]))))
(def: .public (add module [descriptor document output] archive)
(-> Module [Descriptor (Document Any) Output] Archive (Try Archive))
(let [(^slots [#..resolver]) (:representation archive)]
(case (dictionary.get module resolver)
(#.Some [id #.None])
(#try.Success (|> archive
:representation
(update@ #..resolver (dictionary.put module [id (#.Some [descriptor document output])]))
:abstraction))
(#.Some [id (#.Some [existing_descriptor existing_document existing_output])])
(if (is? document existing_document)
... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy...
(#try.Success archive)
(exception.except ..cannot_replace_document [module existing_document document]))
#.None
(exception.except ..module_must_be_reserved_before_it_can_be_added [module]))))
(def: .public (find module archive)
(-> Module Archive (Try [Descriptor (Document Any) Output]))
(let [(^slots [#..resolver]) (:representation archive)]
(case (dictionary.get module resolver)
(#.Some [id (#.Some entry)])
(#try.Success entry)
(#.Some [id #.None])
(exception.except ..module_is_only_reserved [module])
#.None
(exception.except ..unknown_document [module
(dictionary.keys resolver)]))))
(def: .public (archived? archive module)
(-> Archive Module Bit)
(case (..find module archive)
(#try.Success _)
bit.yes
(#try.Failure _)
bit.no))
(def: .public archived
(-> Archive (List Module))
(|>> :representation
(get@ #resolver)
dictionary.entries
(list.all (function (_ [module [id descriptor+document]])
(case descriptor+document
(#.Some _) (#.Some module)
#.None #.None)))))
(def: .public (reserved? archive module)
(-> Archive Module Bit)
(let [(^slots [#..resolver]) (:representation archive)]
(case (dictionary.get module resolver)
(#.Some [id _])
bit.yes
#.None
bit.no)))
(def: .public reserved
(-> Archive (List Module))
(|>> :representation
(get@ #resolver)
dictionary.keys))
(def: .public reservations
(-> Archive (List [Module ID]))
(|>> :representation
(get@ #resolver)
dictionary.entries
(list\map (function (_ [module [id _]])
[module id]))))
(def: .public (merged additions archive)
(-> Archive Archive Archive)
(let [[+next +resolver] (:representation additions)]
(|> archive
:representation
(update@ #next (n.max +next))
(update@ #resolver (function (_ resolver)
(list\fold (function (_ [module [id entry]] resolver)
(case entry
(#.Some _)
(dictionary.put module [id entry] resolver)
#.None
resolver))
resolver
(dictionary.entries +resolver))))
:abstraction)))
(type: Reservation
[Module ID])
(type: Frozen
[Version ID (List Reservation)])
(def: reader
(Parser ..Frozen)
($_ <>.and
<binary>.nat
<binary>.nat
(<binary>.list (<>.and <binary>.text <binary>.nat))))
(def: writer
(Writer ..Frozen)
($_ binary.and
binary.nat
binary.nat
(binary.list (binary.and binary.text binary.nat))))
(def: .public (export version archive)
(-> Version Archive Binary)
(let [(^slots [#..next #..resolver]) (:representation archive)]
(|> resolver
dictionary.entries
(list.all (function (_ [module [id descriptor+document]])
(case descriptor+document
(#.Some _) (#.Some [module id])
#.None #.None)))
[version next]
(binary.run ..writer))))
(exception: .public (version_mismatch {expected Version} {actual Version})
(exception.report
["Expected" (%.nat expected)]
["Actual" (%.nat actual)]))
(exception: .public corrupt_data)
(def: (correct_modules? reservations)
(-> (List Reservation) Bit)
(n.= (list.size reservations)
(|> reservations
(list\map product.left)
(set.of_list text.hash)
set.size)))
(def: (correct_ids? reservations)
(-> (List Reservation) Bit)
(n.= (list.size reservations)
(|> reservations
(list\map product.right)
(set.of_list n.hash)
set.size)))
(def: (correct_reservations? reservations)
(-> (List Reservation) Bit)
(and (correct_modules? reservations)
(correct_ids? reservations)))
(def: .public (import expected binary)
(-> Version Binary (Try Archive))
(do try.monad
[[actual next reservations] (<binary>.run ..reader binary)
_ (exception.assertion ..version_mismatch [expected actual]
(n\= expected actual))
_ (exception.assertion ..corrupt_data []
(correct_reservations? reservations))]
(in (:abstraction
{#next next
#resolver (list\fold (function (_ [module id] archive)
(dictionary.put module [id #.None] archive))
(get@ #resolver (:representation ..empty))
reservations)}))))
)
|
