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
| | (define-module (guix-qa-frontpage patchwork patch-name)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:use-module (ice-9 exceptions)
#:export (<patch-name-metadata>
make-patch-name-metadata
patch-name-metadata?
patch-name-metadata-bug-number
patch-name-metadata-feature-branch
patch-name-metadata-revision
patch-name-metadata-index
patch-name-metadata-total
patch-name-metadata-set-index
&patch-name-parser-error
patch-name-parser-error?
make-patch-name-parser-error
parse-patch-name
synthesize-patch-name
))
(define-record-type <patch-name-metadata>
(make-patch-name-metadata bug-number feature-branch revision index total)
patch-name-metadata?
(bug-number patch-name-metadata-bug-number)
(feature-branch patch-name-metadata-feature-branch)
(revision patch-name-metadata-revision)
(index patch-name-metadata-index)
(total patch-name-metadata-total))
(define (patch-name-metadata-set-index meta index)
(match meta
(($ <patch-name-metadata> bug branch rev _ total)
(make-patch-name-metadata bug branch rev index total))))
(set-record-type-printer!
<patch-name-metadata>
(lambda (record port)
(match record
(($ <patch-name-metadata> bug feature revision index total)
(format port
"#<<patch-name-metadata> \
bug-number=~s feature-branch=~s revision=~s \
index=~s total=~s>"
bug feature revision index total)))))
(define-exception-type &patch-name-parser-error
&error
make-patch-name-parser-error
patch-name-parser-error?)
(define (parse-patch-name name)
"Given a patch @var{name} obtained from Patchwork, infer the metadata
from its name."
(define (raise-error message)
(raise-exception
(make-exception
(make-error)
(make-patch-name-parser-error)
(make-exception-with-message message)
(make-exception-with-irritants (list name))
(make-exception-with-origin 'parse-patch-name))))
(define (as-bug-number arg)
(and (string-prefix? "bug#" arg)
(string->number (substring arg (string-length "bug#")))))
(define (as-revision arg)
(and (string-prefix? "v" arg)
(string->number (substring arg 1))))
(define (as-patch-number arg)
(match (string-split arg #\/)
(((= string->number index) (= string->number total))
(and index total (<= index total)
(cons index total)))
(else #f)))
(unless (string-prefix? "[" name)
(raise-error "the patch name does not start with '['"))
(let ((stop (string-index name #\])))
(unless stop
(raise-error "the patch name does not contain ']'"))
(let ((args (substring name 1 stop)))
(let analyze ((bug-number #f)
(branch "master")
(revision 1)
(index 1)
(total 1)
(arguments
(string-split args #\,)))
(match arguments
((or ("") ())
(begin
(unless bug-number
(raise-error "the patch name does not have a bug number"))
(make-patch-name-metadata bug-number branch revision index total)))
(((= as-bug-number (? number? new-bug-number))
arguments ...)
(analyze new-bug-number branch revision index total arguments))
(((= as-revision (? number? new-revision))
arguments ...)
(analyze bug-number branch new-revision index total arguments))
(((= as-patch-number ((? number? new-index) . (? number? new-total)))
arguments ...)
(analyze bug-number branch revision new-index new-total arguments))
((feature-branch arguments ...)
(analyze bug-number feature-branch revision index total arguments)))))))
(define (synthesize-patch-name meta name)
"Prepend @samp{[bug#nnn,branch,v1,1/1]} to the @var{name}."
(match meta
(($ <patch-name-metadata>
bug-number feature-branch revision
index total)
(format #f "[bug#~a,~a,v~a,~a/~a] ~a"
bug-number feature-branch revision
index total name))))
|