[bug#57460] [PATCH 12/20] refresh: Allow updating to a specific version (kde)

[Hartmut Goebel]

* guix/import/kde.scm(latest-kde-release): Rename to (import-kde-release), add
  keyword-argument 'version'.  Rework the code to not sort the relevant files,
  but just find the requested or latest version.
  [find-latest-archive-version]: New function.
---
 guix/import/kde.scm | 58 ++++++++++++++++++++++++++-------------------
 1 file changed, 34 insertions(+), 24 deletions(-)

diff --git a/guix/import/kde.scm b/guix/import/kde.scm
index 510d823a4f..d364e44edb 100644
--- a/guix/import/kde.scm
+++ b/guix/import/kde.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (web uri)
 
@@ -149,42 +150,51 @@ Output:
       (string-join (map version->pattern directory-parts) "/")
       "/"))))
 
-(define (latest-kde-release package)
+(define* (import-kde-release package #:key (version #f))
   "Return the latest release of PACKAGE, a KDE package, or #f if it could
 not be determined."
+
+  (define (find-latest-archive-version archives)
+    (fold (lambda (file1 file2)
+            (if (and file2
+                     (version>? (tarball-sans-extension (basename file2))
+                                (tarball-sans-extension (basename file1))))
+                file2
+                file1))
+          #f
+          archives))
+
   (let* ((uri      (string->uri (origin-uri (package-source package))))
          (path-rx  (uri->kde-path-pattern uri))
          (name     (package-upstream-name package))
          (files    (download.kde.org-files))
+         ;; select archives for this package
          (relevant (filter (lambda (file)
                              (and (regexp-exec path-rx file)
                                   (release-file? name (basename file))))
-                           files)))
-    (match (sort relevant (lambda (file1 file2)
-                            (version>? (tarball-sans-extension
-                                        (basename file1))
-                                       (tarball-sans-extension
-                                        (basename file2)))))
-           ((and tarballs (reference _ ...))
-            (let* ((version  (tarball->version reference))
-                   (tarballs (filter (lambda (file)
-                                       (string=? (tarball-sans-extension
-                                                  (basename file))
-                                                 (tarball-sans-extension
-                                                  (basename reference))))
-                                     tarballs)))
-              (upstream-source
-               (package name)
-               (version version)
-               (urls (map (lambda (file)
-                            (string-append "mirror://kde/" file))
-                          tarballs)))))
-           (()
-            #f))))
+                           files))
+         ;; find latest version
+         (version (or version
+                      (and (not (null? relevant))
+                           (tarball->version (find-latest-archive-version 
relevant)))))
+         ;; find archives matching this version
+         (archives (filter (lambda (file)
+                             (string=? version (tarball->version file)))
+                           relevant)))
+    (match archives
+           (() #f)
+           (_
+            (upstream-source
+             (package name)
+             (version version)
+             (urls (map (lambda (file)
+                          (string-append "mirror://kde/" file))
+                        archives)))))))
+
 
 (define %kde-updater
   (upstream-updater
     (name 'kde)
     (description "Updater for KDE packages")
     (pred (url-prefix-predicate "mirror://kde/"))
-    (import latest-kde-release)))
+    (import import-kde-release)))
-- 
2.30.4