From 3fba8cd2745e0d983fb24d51aa37ca31e3c5c896 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Thu, 5 Oct 2023 12:58:43 +0200
Subject: refresh: Fix sorting of updates by file and line number.

* guix/scripts/refresh.scm (guix-refresh): Add cascade-sort procedure and use
it to sort specs by package location.
---
 guix/scripts/refresh.scm | 37 +++++++++++++++++++++++++++++++------
 1 file changed, 31 insertions(+), 6 deletions(-)

(limited to 'guix')

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index f39dc743b1..46bf310d5f 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -571,6 +571,28 @@ all are dependent packages: ~{~a~^ ~}~%")
       (lists
        (concatenate lists))))
 
+  ;; Sort SEQUENCE by consecutive application of all tests to selected
+  ;; elements in SEQUENCE.  Every item in LESS+SELECT is a pair consisting of
+  ;; a binary comparison procedure and a selector, e.g (cons < car).
+  (define (cascade-sort sequence . less+select)
+    (define (make-test less? select)
+      (lambda (a b)
+        (less? (select a) (select b))))
+    (define (combine-tests procs)
+      (lambda (a b)
+        (eq? 'less
+             (any (lambda (test)
+                    (cond
+                     ((test a b) 'less)
+                     ((test b a) 'greater)
+                     (else #false)))
+                  procs))))
+    (let ((tests (match less+select
+                   (((less? . select) ...)
+                    (combine-tests
+                     (map make-test less? select))))))
+      (sort sequence tests)))
+
   (let* ((opts            (parse-options))
          (update?         (assoc-ref opts 'update?))
          (updaters        (options->updaters opts))
@@ -605,18 +627,21 @@ all are dependent packages: ~{~a~^ ~}~%")
                               (or (assoc-ref opts 'keyring)
                                   (string-append (config-directory)
                                                  "/upstream/trustedkeys.kbx"))))
-                (let* ((spec-line
-                        (compose (cut string-trim-right <> char-set:digit)
-                                 location->string
-                                 package-location
+                (let* ((spec->location
+                        (compose package-location
                                  update-spec-package))
                        ;; Sort the specs so that we update packages from the
                        ;; bottom of the file to the top.  This way we can be
                        ;; sure that the package locations are always correct
                        ;; and never shifted due to previous edits.
                        (sorted-update-specs
-                        (sort update-specs
-                              (lambda (a b) (string> (spec-line a) (spec-line b))))))
+                        (cascade-sort update-specs
+                                      (cons string<
+                                            (compose location-file
+                                                     spec->location))
+                                      (cons >
+                                            (compose location-line
+                                                     spec->location)))))
                   (for-each
                    (lambda (update)
                      (update-package store
-- 
cgit v1.2.3