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
| | (define-module (guix-qa-frontpage patchwork patch)
#:use-module (guix-qa-frontpage patchwork patch-name)
#:use-module (srfi srfi-9)
#:use-module (ice-9 exceptions)
#:use-module (ice-9 match)
#:use-module (web uri)
#:export (<patch>
patch?
make-patch
patch-index
patch-name
patch-mbox
patch-set-name
patch-name-metadata
patch-set-name-metadata
&invalid-patch-json
invalid-patch-json?
make-invalid-patch-json
scm->patch
patch->scm))
(define-record-type <patch>
(make-patch id index name mbox)
patch?
(id patch-id)
(index patch-index)
(name patch-name)
(mbox patch-mbox))
(define (patch-set-name patch new-name)
(match patch
(($ <patch> id index _ mbox)
(make-patch id index new-name mbox))))
(define (patch-set-name-metadata patch meta)
"Synthesize a new patch name with all the relevant information."
(patch-set-name
patch
(synthesize-patch-name meta (patch-name patch))))
(define-exception-type &invalid-patch-json
&error
make-invalid-patch-json
invalid-patch-json?)
(define (patch-name-metadata patch)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-message
"while parsing patch name metadata")
(make-exception-with-origin 'patch-name-metadata)
(make-exception-with-irritants (list patch))
exn)))
(lambda ()
(parse-patch-name (patch-name patch)))))
(define (scm->patch json-data)
"Get a patch series item from patchwork as JSON."
(let ((id (assoc-ref json-data "id"))
(name (assoc-ref json-data "name"))
(mbox (assoc-ref json-data "mbox")))
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-invalid-patch-json)
(make-exception-with-message "while converting JSON data to a patch")
(make-exception-with-origin 'scm->patch)
(make-exception-with-irritants (list json-data))
exn)))
(lambda ()
(unless (and (integer? id) (>= id 0))
(error "the patch does not have an ID or it is not an integer"))
(unless (string? name)
(error "the patch name is missing or not a string"))
(unless (and (string? mbox) (string->uri mbox))
(error "the patch mbox is not an URI"))
(let ((metadata (parse-patch-name name)))
(make-patch id
(patch-name-metadata-index metadata)
name
(string->uri mbox)))))))
(define (patch->scm patch)
"Convert a patch back to a JSON sexp, so that it can be cached in
database."
`(("id" . ,(patch-id patch))
("name" . ,(patch-name patch))
("mbox" . ,(uri->string (patch-mbox patch)))))
|