blob: df9f7dfa3487d6eeb0f2a043b1c54dc4affdafff (
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
|
(.module:
[lux (#- Name Type)
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ do)]]
[control
["." exception (#+ exception:)]
["<>" parser
["<.>" xml (#+ Parser)]
["<.>" text]]]
[data
["." product]
["." text
["%" format]]
[format
["." xml (#+ XML)]]
[collection
["." list ("#\." functor)]]]
[math
[number
["n" nat]]]
["." time (#+ Time)
["." instant (#+ Instant)]
["." date (#+ Date)]
["." year]
["." month]]]
["." // (#+ Version)
[type (#+ Type)]
["#." value (#+ Build Value)]
["#." time_stamp (#+ Time_Stamp)
["#/." date]
["#/." time]]])
(type: #export Versioning
{#time_stamp Time_Stamp
#build Build
#snapshot (List Type)})
(def: #export init
{#time_stamp (instant.from_millis +0)
#build 0
#snapshot (list)})
(def: #export equivalence
(Equivalence Versioning)
($_ product.equivalence
instant.equivalence
n.equivalence
(list.equivalence text.equivalence)
))
(template [<definition> <tag>]
[(def: <definition> xml.Tag ["" <tag>])]
[<extension> "extension"]
[<value> "value"]
[<updated> "updated"]
[<timestamp> "timestamp"]
[<build_number> "buildNumber"]
[<last_updated> "lastUpdated"]
[<snapshot_versions> "snapshotVersions"]
[<snapshot_version> "snapshotVersion"]
[<snapshot> "snapshot"]
[<versioning> "versioning"]
)
(def: (instant_format value)
(%.Format Instant)
(%.format (//time_stamp/date.format (instant.date value))
(//time_stamp/time.format (instant.time value))))
(template [<name> <type> <tag> <pre>]
[(def: <name>
(-> <type> XML)
(|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))]
[format_extension Type ..<extension> (|>)]
[format_value Value ..<value> //value.format]
[format_updated Instant ..<updated> ..instant_format]
[format_time_stamp Instant ..<timestamp> //time_stamp.format]
[format_build_number Nat ..<build_number> %.nat]
[format_last_updated Instant ..<last_updated> ..instant_format]
)
(def: (format_snapshot value type)
(-> Value Type XML)
(<| (#xml.Node ..<snapshot_version> xml.attributes)
(list (..format_extension type)
(..format_value value)
(let [[version time_stamp build] value]
(..format_updated time_stamp)))))
(def: #export (format version (^slots [#time_stamp #build #snapshot]))
(-> Version Versioning XML)
(<| (#xml.Node ..<versioning> xml.attributes)
(list (<| (#xml.Node ..<snapshot> xml.attributes)
(list (..format_time_stamp time_stamp)
(..format_build_number build)))
(..format_last_updated time_stamp)
(<| (#xml.Node ..<snapshot_versions> xml.attributes)
(list\map (..format_snapshot [version time_stamp build])
snapshot)))))
(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text})
(exception.report
["Expected time-stamp" (instant_format expected)]
["Actual time-stamp" actual]))
(exception: #export (value_mismatch {expected Value} {actual Text})
(exception.report
["Expected" (//value.format expected)]
["Actual" actual]))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
(do <>.monad
[_ (<xml>.node tag)]
(<xml>.children parser)))
(def: (text tag)
(-> xml.Tag (Parser Text))
(..sub tag <xml>.text))
(def: last_updated_parser
(Parser Instant)
(<text>.embed (do <>.monad
[date //time_stamp/date.parser
time //time_stamp/time.parser]
(wrap (instant.from_date_time date time)))
(..text ..<last_updated>)))
(def: time_stamp_parser
(Parser Time_Stamp)
(<text>.embed //time_stamp.parser
(..text ..<timestamp>)))
(def: build_parser
(Parser Build)
(<text>.embed (<>.codec n.decimal
(<text>.many <text>.decimal))
(..text ..<build_number>)))
(def: (snapshot_parser expected)
(-> Value (Parser Type))
(<| (..sub ..<snapshot_version>)
(do <>.monad
[#let [[version time_stamp build] expected]
updated (<xml>.somewhere (..text ..<updated>))
_ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
(\ text.equivalence = (instant_format time_stamp) updated))
actual (<xml>.somewhere (..text ..<value>))
_ (<>.assert (exception.construct ..value_mismatch [expected actual])
(\ text.equivalence = (//value.format expected) actual))]
(<xml>.somewhere (..text ..<extension>)))))
(def: #export (parser version)
(-> Version (Parser Versioning))
(<| (..sub ..<versioning>)
(do <>.monad
[[time_stamp build] (<| <xml>.somewhere
(..sub ..<snapshot>)
(<>.and (<xml>.somewhere ..time_stamp_parser)
(<xml>.somewhere ..build_parser)))
last_updated (<xml>.somewhere ..last_updated_parser)
_ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)])
(\ instant.equivalence = time_stamp last_updated))
snapshot (<| <xml>.somewhere
(..sub ..<snapshot_versions>)
(<>.some (..snapshot_parser [version time_stamp build])))]
(wrap {#time_stamp time_stamp
#build build
#snapshot snapshot}))))
|
