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
| | (define-module (guix-qa-frontpage patchwork patch-series)
#:use-module (guix-qa-frontpage patchwork patch-name)
#:use-module (guix-qa-frontpage patchwork patch)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (ice-9 exceptions)
#:use-module (ice-9 match)
#:export (<patch-series>
patch-series?
make-patch-series
patch-series-id
patch-series-bug-number
patch-series-feature-branch
patch-series-revision
patch-series-patches
&invalid-patch-series-json
invalid-patch-series-json?
make-invalid-patch-series-json
scm->patch-series
patch-series->scm))
(define-record-type <patch-series>
(make-patch-series id bug-number feature-branch revision patches)
patch-series?
(id patch-series-id)
(bug-number patch-series-bug-number)
(feature-branch patch-series-feature-branch)
(revision patch-series-revision)
(patches patch-series-patches))
(define-exception-type &invalid-patch-series-json
&error
make-invalid-patch-series-json
invalid-patch-series-json?)
(define (scm->patch-series json-data)
"Parse a full patch series from JSON data."
(let ((json-patches (assoc-ref json-data "series"))
(id (assoc-ref json-data "id")))
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-invalid-patch-series-json)
(make-exception-with-message
"while converting JSON data to a patch series")
(make-exception-with-origin 'scm->patch-series)
(make-exception-with-irritants (list json-data))
exn)))
(lambda ()
(unless (and (integer? id) (>= id 0))
(raise-exception
(make-exception
(make-exception-with-message
"no \"id\" key in the object, or not an integer")
(make-exception-with-irritants
(list id)))))
(unless json-patches
(raise-exception
(make-exception
(make-exception-with-message
"no \"series\" key in the object"))))
(unless (vector? json-patches)
(raise-exception
(make-exception
(make-exception-with-message
"series is not an array")
(make-exception-with-irritants json-patches))))
(set! json-patches (vector->list json-patches))
(when (null? json-patches)
(raise-exception
(make-exception
(make-exception-with-message
"the series has no patches"))))
(let ((global-metadata
;; There are 2 places where the metadata could be: in
;; the "name" key of the root object, or in the "name"
;; key of any patch.
(or
(false-if-exception
(parse-patch-name (assoc-ref json-data "name")))
(parse-patch-name
(assoc-ref (car json-patches) "name")))))
(let check-patches ((patches json-patches)
(n-checked 0)
(checked '()))
(match patches
(()
(begin
(unless (eqv? n-checked (patch-name-metadata-total global-metadata))
(raise-exception
(make-exception
(make-exception-with-message
(format #f "wrong number of patches in series, expected ~s"
(patch-name-metadata-total global-metadata)))
(make-exception-with-irritants
(list n-checked)))))
(make-patch-series id
(patch-name-metadata-bug-number global-metadata)
(patch-name-metadata-feature-branch global-metadata)
(patch-name-metadata-revision global-metadata)
(reverse checked))))
((next patches ...)
(let ((parsed
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-message
(format #f "while parsing patch ~s/~s"
(1+ n-checked)
(patch-name-metadata-total global-metadata)))
exn)))
(lambda ()
(let* ((expected-meta
(patch-name-metadata-set-index
global-metadata
(1+ n-checked)))
(p
;; Parse the patch, but if it fails,
;; try with a synthetic name that
;; adds the relevant information.
(with-exception-handler
(lambda (no-metadata)
(unless (patch-name-parser-error? no-metadata)
(raise-exception no-metadata))
(let ((incorrect-name
(assoc-ref next "name")))
(scm->patch
`(("name" .
,(synthesize-patch-name
expected-meta
incorrect-name))
,@next))))
(lambda ()
(scm->patch next))
#:unwind? #t
#:unwind-for-type &patch-name-parser-error))
(meta
(patch-name-metadata p))
(expected-meta
(patch-name-metadata-set-index
global-metadata
(1+ n-checked))))
(unless (equal? expected-meta meta)
(raise-exception
(make-exception
(make-exception-with-message
(format #f "the patch has inconsistent metadata: expected ~s"
expected-meta))
(make-exception-with-irritants
(list meta)))))
(unless meta
(set! p (patch-set-name-metadata p expected-meta)))
p)))))
(check-patches patches (1+ n-checked) `(,parsed ,@checked)))))))))))
(define (patch-series->scm series)
"Convert a series back to a JSON sexp, so that it can be cached in
database."
`(("id" . ,(patch-series-id series))
("series" . ,(list->vector
(map patch->scm (patch-series-patches series))))))
|