Re: Mumi, public-inbox and tools

[Ludovic Courtès]

Hello!

The attached super-early-draft ‘guix review’ script fetches mboxes from
mumi—that part is OK.

What’s more difficult is the rest: determining what’s a patch and what’s
not (I gather this is something that b4 and Patchwork handle nicely),
getting the latest patch series, things like that.

Then there’s the big about applying patches in a branch, and optionally
finding out the package differences so the tool can provide feedback and
possibly start building things (I think the Guix Data Service has code
to help with that.)

I think we could have, as a first step, a command that allows us to run:

  ./pre-inst-env guix review 54874

and that fetches patches, applies them, and ideally reports on the
difference and what needs to be built.

It’s a relatively low-hanging fruit after all.

Thoughts?

Ludo’.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.


(define-module (guix scripts review)
  #:use-module (guix scripts)
  #:use-module (guix ui)
  #:use-module (guix i18n)
  #:use-module (guix colors)
  #:use-module (guix http-client)
  #:use-module (guix utils)
  #:use-module ((guix build utils) #:select (find-files invoke))
  #:autoload   (guix inferior) (open-inferior close-inferior
                                               inferior-available-packages)
  #:autoload   (gnu packages) (fold-available-packages)
  #:autoload   (email email) (parse-email email-headers email-body)
  #:use-module (ice-9 binary-ports)
  #:use-module (srfi srfi-1)
  #:use-module (web uri)
  #:use-module (web http)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 format)
  #:export (guix-review))

(define (patch-set-url number)
  (string-append "https://issues.guix.gnu.org/issue/";
                 (number->string number) "/patch-set"))

(define (monkey-patch!)
  ;; XXX: Currently mumi returns "Content-Type: text;...", which is considered
  ;; invalid.  Work around it.
  (declare-header! "Content-Type"
                   (lambda (str)
                     (let ((parts (string-split str #\;)))
                       (cons 'text/plain          ;<- this is the "fix"
                             (map (lambda (x)
                                    (let ((eq (string-index x #\=)))
                                      (cons
                                       (string->symbol
                                        (string-trim x char-set:whitespace 0 
eq))
                                       (string-trim-right x char-set:whitespace 
(1+ eq)))))
                                  (cdr parts)))))
                   (header-validator 'content-type)
                   (header-writer 'content-type))
  (set! monkey-patch! (const #t)))

(define (download-patch-set directory number)
  "Download to DIRECTORY the patches of issue NUMBER."
  (define (patch-file n)
    (format #f "~a/~3,'0d.patch" directory n))

  (define (from-line? str)
    (string-prefix? "From " str))

  (monkey-patch!)
  (let ((port (http-fetch (string->uri (patch-set-url number)))))
    (let loop ((n 0)
               (output (%make-void-port "w0")))
      (match (read-line port 'concat)
        ((? eof-object?)
         (close-port output)
         n)
        ((? from-line? line)
         (close-port output)
         (let* ((n   (+ n 1))
                (new (open-output-file (patch-file n))))
           (display line new)
           (loop n new)))
        (line
         (display line output)
         (loop n output))))))

(define colorize-patch-line
  (color-rules
   ("^(---.*)$" BOLD)
   ("^(\\+\\+\\+.*)$" BOLD)
   ("^(-.*)$" RED)
   ("^(\\+.*)$" GREEN)
   ("^(@@ .* @@)" CYAN)))

(define (display-patch file)
  "Read the patch in FILE and display it to standard output."
  (define email
    (parse-email
     (call-with-input-file file
       (lambda (port)
         (read-line port)                         ;discard the "From " line
         (get-bytevector-all port)))))

  (with-paginated-output-port port
    (match (assoc-ref (email-headers email) 'from)
      ((from)
       (format port "From: ~a <~a>~%"
               (or (assoc-ref from 'name) "")
               (assoc-ref from 'address))
       (format port "Subject: ~a~%"
               (assoc-ref (email-headers email) 'subject))
       (newline port)))

    (call-with-input-string (email-body email)
      (lambda (input)
        (let loop ()
          (match (read-line input 'concat)
            ((? eof-object?)
             #t)
            (line
             (display (colorize-patch-line line) port)
             (loop))
            (_
             (loop))))))))

(define (apply-patch patch)
  (invoke "git" "am" "-s" patch))


;;;
;;; Package differences.
;;;

(define (available-packages)
  (fold-available-packages
   (lambda* (name version result
                  #:key supported? deprecated?
                  #:allow-other-keys)
     (if (and supported? (not deprecated?))
         (alist-cons name version result)
         result))
   '()))

(define (new-available-packages)
  (define %top-builddir
    (dirname (search-path %load-compiled-path "guix.go")))

  (let* ((inferior (open-inferior %top-builddir #:command "scripts/guix"))
         (packages (inferior-available-packages inferior)))
    (close-inferior inferior)
    packages))

;; (define display-new/upgraded-packages
;;   (@@ (guix scripts pull) display-new/upgraded-packages))


;;;
;;; Command-line options.
;;;

(define %default-options
  '((action . apply)))

(define %options
  '())


;;;
;;; Entry point.
;;;

(define-command (guix-review . args)
  (category packaging)
  (synopsis "review patches")

  (with-error-handling
    (let* ((options (parse-command-line args %options
                                        (list %default-options)))
           (issue (match (assoc-ref options 'argument)
                    ((= string->number number)
                     number)
                    (_
                     (leave (G_ "missing issue number~%"))))))
      (call-with-temporary-directory
       (lambda (directory)
         (let ((patches (download-patch-set directory issue)))
           (info (N_ "downloaded ~a patch for issue #~a~%"
                     "downloaded ~a patches for issue #~a~%"
                     patches)
                 patches issue)
           (if (= 1 patches)
               (match (find-files directory)
                 ((patch)
                  (display-patch patch)
                  (info (G_ "hit enter to apply~%"))))
               (info (G_ "screen the patches under ~a and hit enter to apply~%")
                     directory))
           (read-char)

           (let ((old (available-packages)))
             (for-each apply-patch (find-files directory))
             (invoke "make")
             (let ((new (new-available-packages)))
               (pk 'diff (lset-difference equal? new old))
               (display-new/upgraded-packages old new
                                              #:concise? #f)))))))))

;; Local Variables:
;; eval: (put 'with-binding 'scheme-indent-function 2)
;; End: