Subject: [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff.

From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 16:36:05 +0200

Hi Guix,

I snarfed these from my cc-for-target branch.
Examples of generated commit messages, without any massaging:

<start snip>
gnu: ufoai-data: Use 'cc-for-target' and friends.

* gnu/packages/games.scm (ufoai-data)
[arguments]<#:configure-flags>: Use the C cross-compiler, instead of hardcoding "gcc". Use the C++ cross-compiler, instead of hardcoding "g++".

gnu: mlt: Use 'cc-for-target' and friends.

* gnu/packages/video.scm (mlt)
[arguments]<#:make-flags>: Use the C cross-compiler, instead of hardcoding "gcc". Use the C++ cross-compiler, instead of hardcoding "g++".

gnu: theorafile: Use the C cross-compiler.

* gnu/packages/video.scm (theorafile)
[arguments]<#:make-flags>: Use the C cross-compiler, instead of hardcoding "gcc".
[arguments]<#:phases>{check}: Only run tests when not requested.
<end snip>

etc/comitter.scm.in should probably do some line wrapping as well.

WDYT?

Greetings,
Maxime.
From 7752bce327d7daec5825d94d195046cf1f4d7fb9 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 11:21:03 +0200
Subject: [PATCH 1/6] etc: Teach committer.scm about CC=gcc -> cc-for-target
 and friends.

* etc/committer.scm.in
  (keyword-list->alist): New procedure.
  (pairwise-foreach-keyword): Likewise.
  (explain-list-delta): New procedure, for explaining a delta between
  two lists.
  (change-commit-message)[get-values/list]: New procedure.
  (change-commit-message)[explain-make-flags/change]: New procedure,
  currently explaining a transition from "CC=gcc" to "CC=" (cc-for-target)
  in the make flags.
  (change-commit-message)[explain-argument]: New procedure for explaining
  a difference in the 'arguments' field. Currently only #:make-flags is
  supported, using the previous procedure.
---
 etc/committer.scm.in | 96 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 94 insertions(+), 2 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 801b5d195e..75c82c9019 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -4,6 +4,7 @@
 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <[email-masked]>
+;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,8 @@
         (ice-9 popen)
         (ice-9 match)
         (ice-9 rdelim)
-        (ice-9 textual-ports))
+        (ice-9 textual-ports)
+        (rnrs control))
 
 (define (read-excursion port)
   "Read an expression from PORT and reset the port position before returning
@@ -173,6 +175,60 @@ corresponding to the top-level definition containing the staged changes."
                         (+ (lines-to-first-change hunk)
                            (hunk-new-line-number hunk))))))
 
+(define (keyword-list->alist kwlist)
+  (match kwlist
+    (() '())
+    (((? keyword? k) object . rest)
+     `((,k . ,object) . ,(keyword-list->alist rest)))))
+
+(define (pairwise-foreach-keyword proc . arguments)
+  "Apply PROC with each keyword argument and corresponding values
+in ARGUMENTS.  If a value is not present in a argument, pass #f instead."
+  (let* ((alists (map keyword-list->alist arguments))
+         (keywords (delete-duplicates
+                    (apply append (map (cut map car <>) alists))
+                    eq?)))
+    (for-each (lambda (keyword)
+                (apply proc keyword
+                       (map (cut assoc-ref <> keyword) alists)))
+              keywords)))
+
+(define* (explain-list-delta old new #:key pairwise/change)
+  "Try to explain the changes from the list OLD to NEW.
+
+If passed, the explainer @var{pairwise/change} must accept two
+arguments: an entry of @var{old} and @var{new}. It can be called
+for each pair of old and new entries.  It should return truth if
+the change could be explained, and false otherwise.
+
+Return false if all changes could be explained and truth otherwise."
+  (let* ((old-vector (list->vector old))
+         (new-vector (list->vector new))
+         (old-explained? (make-bitvector (vector-length old-vector) #f))
+         (new-explained? (make-bitvector (vector-length new-vector) #f)))
+    (do ((i 0 (and (< (+ i 1) (vector-length old-vector))
+                   (bitvector-position old-explained? #f (+ 1 i)))))
+        ((not i))
+      (do ((j 0 (and (< (+ j 1) (vector-length new-vector))
+                     (bitvector-position new-explained? #f (+ 1 j)))))
+          ((not j))
+        (cond ((or (bitvector-bit-set? old-explained? i)
+                   (bitvector-bit-set? new-explained? j)))
+              ;; If two entries are equal, there is no change.
+              ;; (Except possibly some reordering, which we currently
+              ;; do not check for.)
+              ((equal? (vector-ref old-vector i)
+                       (vector-ref new-vector j))
+               (bitvector-set-bit! old-explained? i)
+               (bitvector-set-bit! new-explained? j))
+              ((and pairwise/change
+                    (pairwise/change (vector-ref old-vector i)
+                                     (vector-ref new-vector j)))
+               (bitvector-set-bit! old-explained? i)
+               (bitvector-set-bit! new-explained? j)))))
+    (or (bitvector-position old-explained? #f)
+        (bitvector-position new-explained? #f))))
+
 (define* (change-commit-message file-name old new #:optional (port (current-output-port)))
   "Print ChangeLog commit message for changes between OLD and NEW."
   (define (get-values expr field)
@@ -180,6 +236,14 @@ corresponding to the top-level definition containing the staged changes."
       (() '())
       ((first . rest)
        (map cadadr first))))
+  ;; Like get-values, but also allow quote and do not treat
+  ;; the value of the field as an alist.
+  (define (get-values/list expr field)
+    (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote))
+                                          (sxpath '(quote))))) expr)
+      (() '())
+      ((first . rest)
+       (second first))))
   (define (listify items)
     (match items
       ((one) one)
@@ -216,7 +280,35 @@ corresponding to the top-level definition containing the staged changes."
                                  (format #f "Remove ~a; add ~a."
                                          (listify removed)
                                          (listify added)))))))))
-            '(inputs propagated-inputs native-inputs)))
+            '(inputs propagated-inputs native-inputs))
+  (define (explain-make-flags/change x y)
+    (match (cons x y)
+      (("CC=gcc" . ',(string-append "CC=" (cc-for-target)))
+       (format port
+               " Use the C cross-compiler, instead of hardcoding \"gcc\".")
+       #t)
+      (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target)))
+       (format port
+               " Use the C++ cross-compiler, instead of hardcoding \"g++\".")
+       #t)
+      (_ #f)))
+  (define (explain-argument keyword old new)
+    (unless (equal? old new)
+      (case keyword
+        ((#:make-flags)
+         (format port "[arguments]<#:make-flags>:")
+         ;; second: skip ' and `
+         (if (explain-list-delta (second old) (second new)
+                                 #:pairwise/change explain-make-flags/change)
+             ;; There were some unexplained changes.
+             (format port " Update.~%")
+             (format port "~%")))
+        ;; There were some unexplained changes.
+        (else (format port "[arguments]<~a>: Update.~%" keyword)))))
+  (let ((old-arguments (or (get-values/list old 'arguments) '()))
+        (new-arguments (or (get-values/list new 'arguments) '())))
+    (pairwise-foreach-keyword explain-argument old-arguments
+                              new-arguments)))
 
 (define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
   "Print ChangeLog commit message for a change to FILE-NAME adding a definition."
-- 
2.31.1

From ae06b43db712697f7080cc8e5f4d3eecd9350211 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 13:32:41 +0200
Subject: [PATCH 2/6] etc: Teach committer.scm about checking tests? in the
 'check' phase.

* etc/committer.scm.in
  (has-explicit-argument?): New procedure.
  (change-commit-message)[explain-argument]<#:phases>: New case,
  try explaining changes in #:phases.
  (explain-phases/change): New procedure, explain the patch makes
  sure 'tests?' is respected in the 'check' phase.
---
 etc/committer.scm.in | 46 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 75c82c9019..3fa70a81d0 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -229,6 +229,26 @@ Return false if all changes could be explained and truth otherwise."
     (or (bitvector-position old-explained? #f)
         (bitvector-position new-explained? #f))))
 
+(define (has-explicit-argument? argument-to-search-for argument-list)
+  "Test whether ARGUMENT-TO-SEARCH-FOR occurs in ARGUMENT-LIST."
+  (let loop ((argument-list argument-list))
+    ;; (lambda () exp)
+    (cond ((null? argument-list) #f)
+          ;; (lambda (x . rest) exp)
+          ((pair? argument-list)
+           (let ((argument-in-list (car argument-list))
+                 (rest (cdr argument-list)))
+             (cond ((eq? argument-in-list argument-to-search-for)
+                    #t)
+                   ;; (lambda* (#:key (x . default) . rest) #f)
+                   ((and (pair? argument-in-list)
+                         (eq? (car argument-in-list) argument-to-search-for))
+                    #t)
+                   (#t (loop rest)))))
+          ;; (lambda _ exp)
+          ((symbol? argument-list) #f)
+          (#t (error "the argument list seems to be incorrect!")))))
+
 (define* (change-commit-message file-name old new #:optional (port (current-output-port)))
   "Print ChangeLog commit message for changes between OLD and NEW."
   (define (get-values expr field)
@@ -292,6 +312,21 @@ Return false if all changes could be explained and truth otherwise."
                " Use the C++ cross-compiler, instead of hardcoding \"g++\".")
        #t)
       (_ #f)))
+  (define (explain-phases/change x y)
+    (match (cons x y)
+      ;; "guix build" supports a --without-tests=PACKAGE option,
+      ;; for building a package without running tests.  Also, tests
+      ;; can often not be run when cross-compiling.  The 'check'
+      ;; phase needs to respect this, though.  Maybe this patch is
+      ;; for ensuring the phase respects this.
+      ((('replace ''check ((or 'lambda* 'lambda) args/x . exps/x))
+        . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y)))
+       (when (and (not (has-explicit-argument? 'tests? args/x))
+                  (has-explicit-argument? 'tests? args/y))
+         (format port
+                 "[arguments]<#:phases>{check}: Only run tests when not requested.~%")
+         #t))
+      (_ #f)))
   (define (explain-argument keyword old new)
     (unless (equal? old new)
       (case keyword
@@ -303,6 +338,17 @@ Return false if all changes could be explained and truth otherwise."
              ;; There were some unexplained changes.
              (format port " Update.~%")
              (format port "~%")))
+        ((#:phases)
+         ;; For each phase, a separate line will be printed.
+         (match (cons old new)
+           ;; _ can be %standard-phases, for example
+           ((('modify-phases _ . rest/old) . ('modify-phases _ . rest/new))
+            (if (explain-list-delta rest/old rest/new
+                                    #:pairwise/change explain-phases/change)
+                ;; There were some unexplained changes.
+                (format port "[arguments]<#:phases>: Update.~%")))
+           ;; There were some unexplained changes.
+           (_ (format port "[arguments]<#:phases>: Update.~%"))))
         ;; There were some unexplained changes.
         (else (format port "[arguments]<~a>: Update.~%" keyword)))))
   (let ((old-arguments (or (get-values/list old 'arguments) '()))
-- 
2.31.1

From 31c36574e73ba448b0a883f046dbb5021882273e Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 13:56:17 +0200
Subject: [PATCH 3/6] etc: committer: Only claim to be updating a package when
 it's true.

* etc/committer.scm.in (change-commit-message): If the patch does not
  change the version, do not falsely say the package is updated, and
  instead output a placeholder to be filled in by the user.
---
 etc/committer.scm.in | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 3fa70a81d0..8027d9d0f1 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -274,12 +274,17 @@ Return false if all changes could be explained and truth otherwise."
                       ", and " (first (take-right items 1))))))
   (define variable-name
     (second old))
-  (define version
-    (and=> ((sxpath '(// version *any*)) new)
+  (define (version exp)
+    (and=> ((sxpath '(// version *any*)) exp)
            first))
-  (format port
-          "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
-          variable-name version file-name variable-name version)
+  (define old-version (version old))
+  (define new-version (version new))
+  (cond ((not (equal? old-version new-version))
+         (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
+                 variable-name new-version file-name variable-name new-version))
+        (#t
+         (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%"
+                 variable-name file-name variable-name)))
   (for-each (lambda (field)
               (let ((old-values (get-values old field))
                     (new-values (get-values new field)))
-- 
2.31.1

From 4b158786136693d17517f5474f5cd054639c3cd2 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 15:02:20 +0200
Subject: [PATCH 4/6] etc: committer: Automatically generate a first line in
 more cases.

* etc/committer.scm.in
  (<patch-summary>, make-patch-summary, patch-summary?)
  (patch-summary:cc-for-target, patch-summary:cxx-for-target)
  (set-patch-summary:cc-for-target!, set-patch-summary:cxx-for-target!)
  (set-patch-summary:respect-tests?!, patch-summary:respect-tests?): Define
  record type for keeping track of what the current patch is doing.
  (change-commit-message): Rename to ...
  (change-commit-message/one-pass): ... this, record information about
  the current patch in a <patch-summary> record, and use that information
  for creating the first line of the commit message.
  (change-commit-message): New procedure, with the same calling convention
  as the old change-commit-message.
  (change-commit-message)[explain-make-flags/change]: Populate the patch
  summary.
  (change-commit-message)[explain-phases/change]: Likewise.
---
 etc/committer.scm.in | 50 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 2 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 8027d9d0f1..be23367f49 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -249,8 +249,29 @@ Return false if all changes could be explained and truth otherwise."
           ((symbol? argument-list) #f)
           (#t (error "the argument list seems to be incorrect!")))))
 
-(define* (change-commit-message file-name old new #:optional (port (current-output-port)))
-  "Print ChangeLog commit message for changes between OLD and NEW."
+;; A machine-readable summary of changes made,
+;; that are required for deciding on the first line
+;; of the commit message.
+(define-record-type <patch-summary>
+  (%make-patch-summary cc-for-target cxx-for-target respect-tests?)
+  patch-summary?
+  ;; #f | created | corrected
+  (cc-for-target patch-summary:cc-for-target set-patch-summary:cc-for-target!)
+  (cxx-for-target patch-summary:cxx-for-target set-patch-summary:cxx-for-target!)
+  ;; #f | #t
+  (respect-tests? patch-summary:respect-tests? set-patch-summary:respect-tests?!))
+
+(define (make-patch-summary)
+  (%make-patch-summary #f #f #f))
+
+(define* (change-commit-message/one-pass
+          file-name old new summary
+          #:optional (port (current-output-port)))
+  "Print ChangeLog commit message for changes between OLD and NEW.
+Record information for deciding on the first line in SUMMARY.
+As the information is only recorded after the first line has been written
+to PORT, you should probably run this procedure twice, but with the same
+SUMMARY: first using a ‘void port’, then with the ‘real’ output port."
   (define (get-values expr field)
     (match ((sxpath `(// ,field quasiquote *)) expr)
       (() '())
@@ -282,6 +303,19 @@ Return false if all changes could be explained and truth otherwise."
   (cond ((not (equal? old-version new-version))
          (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
                  variable-name new-version file-name variable-name new-version))
+        ((and (patch-summary:cc-for-target summary)
+              (patch-summary:cxx-for-target summary))
+         (format port "gnu: ~a: Use 'cc-for-target' and friends.~%~%* ~a (~a)~%"
+                 variable-name file-name variable-name))
+        ((patch-summary:cc-for-target summary)
+         (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%"
+                 variable-name file-name variable-name))
+        ((patch-summary:cxx-for-target summary)
+         (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%"
+                 variable-name file-name variable-name))
+        ((patch-summary:respect-tests? summary)
+         (format port "gnu: ~a: Only run tests when requested.~%~% ~a (~a)~%"
+                 variable-name file-name variable-name))
         (#t
          (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%"
                  variable-name file-name variable-name)))
@@ -309,10 +343,12 @@ Return false if all changes could be explained and truth otherwise."
   (define (explain-make-flags/change x y)
     (match (cons x y)
       (("CC=gcc" . ',(string-append "CC=" (cc-for-target)))
+       (set-patch-summary:cc-for-target! summary 'changed)
        (format port
                " Use the C cross-compiler, instead of hardcoding \"gcc\".")
        #t)
       (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target)))
+       (set-patch-summary:cxx-for-target! summary 'changed)
        (format port
                " Use the C++ cross-compiler, instead of hardcoding \"g++\".")
        #t)
@@ -328,6 +364,7 @@ Return false if all changes could be explained and truth otherwise."
         . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y)))
        (when (and (not (has-explicit-argument? 'tests? args/x))
                   (has-explicit-argument? 'tests? args/y))
+         (set-patch-summary:respect-tests?! summary #t)
          (format port
                  "[arguments]<#:phases>{check}: Only run tests when not requested.~%")
          #t))
@@ -361,6 +398,15 @@ Return false if all changes could be explained and truth otherwise."
     (pairwise-foreach-keyword explain-argument old-arguments
                               new-arguments)))
 
+(define* (change-commit-message file-name old new
+                                #:optional (port (current-output-port)))
+  "Like change-commit-message/one-pass, but without requiring to be run twice
+for a correct header."
+  (let ((summary (make-patch-summary)))
+    (change-commit-message/one-pass file-name old new summary
+                                    (%make-void-port "w"))
+    (change-commit-message/one-pass file-name old new summary port)))
+
 (define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
   "Print ChangeLog commit message for a change to FILE-NAME adding a definition."
   (format port
-- 
2.31.1

From 061175155983d73f1488f2cf22d6d52bd5ed3054 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 15:32:08 +0200
Subject: [PATCH 5/6] etc: committer: Support (list exp ...) in #:make-flags.

* etc/committer.scm.in
  (unwrap-list): New procedure, supporting 'quasiquote', 'quote'
  and 'list'.
  (change-commit-message/one-pass)[unwrap-list]: Use new procedure.
---
 etc/committer.scm.in | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index be23367f49..fc3c929f17 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -264,6 +264,15 @@ Return false if all changes could be explained and truth otherwise."
 (define (make-patch-summary)
   (%make-patch-summary #f #f #f))
 
+;; '(x ...) -> (x ...)
+;; `(x ...) -> (x ...)
+;; (list x ...) -> (x ...)
+(define (unwrap-list list)
+  (case (car list)
+    ((quasiquote quote) (second list))
+    ((list) (cdr list))
+    (else (error "I can't interpret that as a list!"))))
+
 (define* (change-commit-message/one-pass
           file-name old new summary
           #:optional (port (current-output-port)))
@@ -374,8 +383,7 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port."
       (case keyword
         ((#:make-flags)
          (format port "[arguments]<#:make-flags>:")
-         ;; second: skip ' and `
-         (if (explain-list-delta (second old) (second new)
+         (if (explain-list-delta (unwrap-list old) (unwrap-list new)
                                  #:pairwise/change explain-make-flags/change)
              ;; There were some unexplained changes.
              (format port " Update.~%")
-- 
2.31.1

From 295cca1e1745acfea49b54681d566dd3d0c1dd19 Mon Sep 17 00:00:00 2001
From: Maxime Devos <[email-masked]>
Date: Fri, 30 Apr 2021 15:45:02 +0200
Subject: [PATCH 6/6] etc: committer: Explain changes in #:configure-flags.

* etc/committer.scm.in
  (change-commit-message/one-pass)[explain-argument]: Handle
  #:configure-flags the same way as #:make-flags for now.
---
 etc/committer.scm.in | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index fc3c929f17..0fd383533d 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -381,8 +381,12 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port."
   (define (explain-argument keyword old new)
     (unless (equal? old new)
       (case keyword
-        ((#:make-flags)
-         (format port "[arguments]<#:make-flags>:")
+        ;; Sometimes, arguments like "CC=TARGET-gcc" are passed to the
+        ;; configure script.  Their interpretation is sometimes the same
+        ;; as in makefiles.  Hence, for now we unify the handling of
+        ;; #:make-flags and #:configure-flags.
+        ((#:make-flags #:configure-flags)
+         (format port "[arguments]<~a>:" keyword)
          (if (explain-list-delta (unwrap-list old) (unwrap-list new)
                                  #:pairwise/change explain-make-flags/change)
              ;; There were some unexplained changes.
-- 
2.31.1