From: Vivien Kraus <vivien@planete-kraus.eu>
To: Christopher Baines <mail@cbaines.net>
Cc: guix-devel@gnu.org
Subject: [PATCH qa-frontpage WIP] Add a library to parse patchwork json data
Date: Tue, 19 Sep 2023 19:37:46 +0200 [thread overview]
Message-ID: <96dbe856c24031965ed4087adab8507b797920dd.1695152179.git.vivien@planete-kraus.eu> (raw)
In-Reply-To: <87cyyew4g8.fsf@cbaines.net>
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 17973 bytes --]
---
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
next prev parent reply other threads:[~2023-09-19 19:45 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-09-17 5:42 [PATCH qa-frontpage] Apply incoming patches onto the correct feature branch Vivien Kraus
2023-09-19 14:33 ` Christopher Baines
2023-09-19 17:37 ` Vivien Kraus [this message]
2023-09-25 12:59 ` [PATCH qa-frontpage WIP] Add a library to parse patchwork json data Christopher Baines
2023-10-21 16:35 ` [PATCH qa-frontpage] Apply incoming patches onto the correct feature branch Christopher Baines
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=96dbe856c24031965ed4087adab8507b797920dd.1695152179.git.vivien@planete-kraus.eu \
--to=vivien@planete-kraus.eu \
--cc=guix-devel@gnu.org \
--cc=mail@cbaines.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).