01/05: etc/committer: Do not recompute changes when there are no definitions.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 0836af9a3b33813e69ece7075fbc222fdb85bfb3
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Thu Sep 21 16:00:24 2023 +0200

    etc/committer: Do not recompute changes when there are no definitions.
    
    * etc/committer.scm.in (main): Reuse previously computed changes if there 
are
    no changes to the number of definitions.
---
 etc/committer.scm.in | 75 ++++++++++++++++++++++++++++------------------------
 1 file changed, 40 insertions(+), 35 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index e7f1ca8c45..cc3b572710 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -388,41 +388,46 @@ modifying."
               (unless (eqv? 0 (status:exit-val (close-pipe port)))
                 (error "Cannot commit"))))
           (usleep %delay))
-        definitions))
+        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))))))
+       ;; 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")))))))
+        (new+old+hunks (match definitions
+                         ('() changes) ;reuse
+                         (_
+                          ;; XXX: we recompute the hunks here because previous
+                          ;; insertions lead to offsets.
+                          (let-values (((definitions changes)
+                                        (partition hunk-type (diff-info))))
+                            changes)))))))))
 
 (apply main (cdr (command-line)))