---
Hi!

Here is a small library that exports 3 types:
− <patch-name-metadata> is the collection of metadata that is present
  in the square brackets in the patch names;
− <patch> is an individual item of the patch series;
− <patch-series> is a whole series of patches;

And a set of functions to parse and serialize these.

A fun experiment is to run the following script:

(use-modules (guix-qa-frontpage patchwork patch-series))
(use-modules (rnrs bytevectors))
(use-modules (web client))
(use-modules (ice-9 receive))
(use-modules (json))

(define patchwork-data
  (receive (r body)
      (http-get "https://patches.guix-patches.cbaines.net/api/patches/?order=-id")
    (json-string->scm (utf8->string body))))

(define patchwork-series
  (map scm->patch-series (vector->list patchwork-data)))

(for-each
 (lambda (correct-series)
   (display correct-series)
   (newline))
 (map patch-series->scm patchwork-series))

You will see that patchwork has quite a lot of creativity when it
comes to breaking my expectations. I made sure to add as much
information in exceptions so that we can understand what is happening.

Best regards,

Vivien

 Makefile.am                                  |   3 +
 guix-qa-frontpage/patchwork/patch-name.scm   | 117 +++++++++++++
 guix-qa-frontpage/patchwork/patch-series.scm | 165 +++++++++++++++++++
 guix-qa-frontpage/patchwork/patch.scm        |  93 +++++++++++
 4 files changed, 378 insertions(+)
 create mode 100644 guix-qa-frontpage/patchwork/patch-name.scm
 create mode 100644 guix-qa-frontpage/patchwork/patch-series.scm
 create mode 100644 guix-qa-frontpage/patchwork/patch.scm

diff --git a/Makefile.am b/Makefile.am
index 79b7032..7b00ea9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -32,6 +32,9 @@ SOURCES =									\
   guix-qa-frontpage/server.scm							\
   guix-qa-frontpage/database.scm						\
   guix-qa-frontpage/patchwork.scm						\
+  guix-qa-frontpage/patchwork/patch-name.scm					\
+  guix-qa-frontpage/patchwork/patch.scm						\
+  guix-qa-frontpage/patchwork/patch-series.scm					\
   guix-qa-frontpage/guix-data-service.scm					\
   guix-qa-frontpage/branch.scm							\
   guix-qa-frontpage/issue.scm							\
diff --git a/guix-qa-frontpage/patchwork/patch-name.scm b/guix-qa-frontpage/patchwork/patch-name.scm
new file mode 100644
index 0000000..1b4cd97
--- /dev/null
+++ b/guix-qa-frontpage/patchwork/patch-name.scm
@@ -0,0 +1,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))))
diff --git a/guix-qa-frontpage/patchwork/patch-series.scm b/guix-qa-frontpage/patchwork/patch-series.scm
new file mode 100644
index 0000000..20e2c61
--- /dev/null
+++ b/guix-qa-frontpage/patchwork/patch-series.scm
@@ -0,0 +1,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))))))
diff --git a/guix-qa-frontpage/patchwork/patch.scm b/guix-qa-frontpage/patchwork/patch.scm
new file mode 100644
index 0000000..0209476
--- /dev/null
+++ b/guix-qa-frontpage/patchwork/patch.scm
@@ -0,0 +1,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)))))

base-commit: 96e85c3ff9dbc55bcabeceff6ef45c54151ce7b3
-- 
2.41.0