[bug#55424] [PATCH 003/602] etc/committer: Teach it how to commit package removal.

[Maxim Cournoyer]

* etc/committer.scm.in (hunk-types): New variable.
(<hunk>): Rename hunk-definition? getter to 'hunk-type'.
(diff-info): Mute a git warning by separating file names from arguments with
'--'.  Rename the 'definitions?' variable to 'type'.
Use the 'addition type when a new package addition is detected, 'removal when
removed else #f.
(add-commit-message): Re-indent.
(remove-commit-message): New procedure.
(main)[definitions]: Make commit message conditional depending on whether it
is an addition or removal.
[changes]: Adjust indentation.
---
 etc/committer.scm.in | 164 ++++++++++++++++++++++++-------------------
 1 file changed, 91 insertions(+), 73 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 3b37320e89..e7f1ca8c45 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -101,12 +101,16 @@ (define (surrounding-sexp port line-no)
            (read-line port)
            (loop (1- i) last-top-level-sexp))))))
 
+;;; Whether the hunk contains a newly added package (definition), a removed
+;;; package (removal) or something else (#false).
+(define hunk-types '(addition removal #false))
+
 (define-record-type <hunk>
   (make-hunk file-name
              old-line-number
              new-line-number
              diff-lines
-             definition?)
+             type)
   hunk?
   (file-name       hunk-file-name)
   ;; Line number before the change
@@ -115,8 +119,8 @@ (define-record-type <hunk>
   (new-line-number hunk-new-line-number)
   ;; The full diff to be used with "git apply --cached"
   (diff-lines hunk-diff-lines)
-  ;; Does this hunk add a definition?
-  (definition? hunk-definition?))
+  ;; Does this hunk add or remove a package?
+  (type hunk-type))                     ;one of 'hunk-types'
 
 (define* (hunk->patch hunk #:optional (port (current-output-port)))
   (let ((file-name (hunk-file-name hunk)))
@@ -134,25 +138,30 @@ (define (diff-info)
                           ;; new definitions with changes to existing
                           ;; definitions.
                           "--unified=1"
-                          "gnu")))
+                          "--" "gnu")))
     (define (extract-line-number line-tag)
       (abs (string->number
             (car (string-split line-tag #\,)))))
     (define (read-hunk)
       (let loop ((lines '())
-                 (definition? #false))
+                 (type #false))
         (let ((line (read-line port 'concat)))
           (cond
            ((eof-object? line)
-            (values (reverse lines) definition?))
+            (values (reverse lines) type))
            ((or (string-prefix? "@@ " line)
                 (string-prefix? "diff --git" line))
             (unget-string port line)
-            (values (reverse lines) definition?))
+            (values (reverse lines) type))
            (else
             (loop (cons line lines)
-                  (or definition?
-                      (string-prefix? "+(define" line))))))))
+                  (or type
+                      (cond
+                       ((string-prefix? "+(define" line)
+                        'addition)
+                       ((string-prefix? "-(define" line)
+                        'removal)
+                       (else #false)))))))))
     (define info
       (let loop ((acc '())
                  (file-name #f))
@@ -167,13 +176,13 @@ (define info
             (match (string-split line #\space)
               ((_ old-start new-start . _)
                (let-values
-                   (((diff-lines definition?) (read-hunk)))
+                   (((diff-lines type) (read-hunk)))
                  (loop (cons (make-hunk file-name
                                         (extract-line-number old-start)
                                         (extract-line-number new-start)
                                         (cons (string-append line "\n")
                                               diff-lines)
-                                        definition?) acc)
+                                        type) acc)
                        file-name)))))
            (else (loop acc file-name))))))
     (close-pipe port)
@@ -263,10 +272,18 @@ (define version
                                           (listify added))))))))))
             '(inputs propagated-inputs native-inputs)))
 
-(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
-          "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
+(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 "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
+          variable-name file-name variable-name))
+
+(define* (remove-commit-message file-name variable-name
+                                #:optional (port (current-output-port)))
+  "Print ChangeLog commit message for a change to FILE-NAME removing a
+definition."
+  (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
           variable-name file-name variable-name))
 
 (define* (custom-commit-message file-name variable-name message changelog
@@ -345,66 +362,67 @@ (define* (change-commit-message* file-name old new #:rest 
rest)
     (()
      (display "Nothing to be done.\n" (current-error-port)))
     (hunks
-     (let-values
-         (((definitions changes)
-           (partition hunk-definition? hunks)))
+     (let-values (((definitions changes) (partition hunk-type hunks)))
+       ;; Additions/removals.
+       (for-each
+        (lambda (hunk)
+          (and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" 
<>)
+                                        (hunk-diff-lines hunk)))
+                     (variable-name (and=> (string-tokenize define-line)
+                                           second))
+                     (commit-message-proc (match (hunk-type hunk)
+                                            ('addition add-commit-message)
+                                            ('removal remove-commit-message))))
+            (commit-message-proc (hunk-file-name hunk) variable-name)
+            (let ((port (open-pipe* OPEN_WRITE
+                                    "git" "apply"
+                                    "--cached"
+                                    "--unidiff-zero")))
+              (hunk->patch hunk port)
+              (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                (error "Cannot apply")))
 
-       ;; Additions.
-       (for-each (lambda (hunk)
-                   (and-let*
-                       ((define-line (find (cut string-prefix? "+(define" <>)
-                                           (hunk-diff-lines hunk)))
-                        (variable-name (and=> (string-tokenize define-line) 
second)))
-                     (add-commit-message (hunk-file-name hunk) variable-name)
-                     (let ((port (open-pipe* OPEN_WRITE                   
-                                             "git" "apply"                
-                                             "--cached"                   
-                                             "--unidiff-zero")))          
-                       (hunk->patch hunk port)                            
-                       (unless (eqv? 0 (status:exit-val (close-pipe port))) 
-                         (error "Cannot apply")))
+            (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+              (commit-message-proc (hunk-file-name hunk) variable-name port)
+              (usleep %delay)
+              (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                (error "Cannot commit"))))
+          (usleep %delay))
+        definitions))
 
-                     (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" 
"-")))
-                       (add-commit-message (hunk-file-name hunk)
-                                           variable-name port)
-                       (usleep %delay)
+     ;; Changes.
+     (for-each
+      (match-lambda
+        ((new old . hunks)
+         (for-each (lambda (hunk)
+                     (let ((port (open-pipe* OPEN_WRITE
+                                             "git" "apply"
+                                             "--cached"
+                                             "--unidiff-zero")))
+                       (hunk->patch hunk port)
                        (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                         (error "Cannot commit"))))
-                   (usleep %delay))
-                 definitions)
-
-       ;; Changes.
-       (for-each (match-lambda
-                   ((new old . hunks)
-                    (for-each (lambda (hunk)
-                                (let ((port (open-pipe* OPEN_WRITE
-                                                        "git" "apply"
-                                                        "--cached"
-                                                        "--unidiff-zero")))
-                                  (hunk->patch hunk port)
-                                  (unless (eqv? 0 (status:exit-val (close-pipe 
port)))
-                                    (error "Cannot apply")))
-                                (usleep %delay))
-                              hunks)
-                    (define copyright-line
-                      (any (lambda (line) (and=> (string-prefix? "+;;; 
Copyright ©" line)
-                                              (const line)))
-                                (hunk-diff-lines (first hunks))))
-                    (cond
-                     (copyright-line
-                      (add-copyright-line copyright-line))
-                     (else
-                      (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" 
"-")))
-                        (change-commit-message* (hunk-file-name (first hunks))
-                                                old new)
-                      (change-commit-message* (hunk-file-name (first hunks))
-                                              old new
-                                              port)
-                      (usleep %delay)
-                      (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                        (error "Cannot commit")))))))
-                 ;; XXX: we recompute the hunks here because previous
-                 ;; insertions lead to offsets.
-                 (new+old+hunks (diff-info)))))))
+                         (error "Cannot apply")))
+                     (usleep %delay))
+                   hunks)
+         (define copyright-line
+           (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
+                                      (const line)))
+                (hunk-diff-lines (first hunks))))
+         (cond
+          (copyright-line
+           (add-copyright-line copyright-line))
+          (else
+           (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+             (change-commit-message* (hunk-file-name (first hunks))
+                                     old new)
+             (change-commit-message* (hunk-file-name (first hunks))
+                                     old new
+                                     port)
+             (usleep %delay)
+             (unless (eqv? 0 (status:exit-val (close-pipe port)))
+               (error "Cannot commit")))))))
+      ;; XXX: we recompute the hunks here because previous
+      ;; insertions lead to offsets.
+      (new+old+hunks (diff-info))))))
 
 (apply main (cdr (command-line)))
-- 
2.36.0