11/15: home: import: Factorize triplicated 'version-spec' procedure.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 96728c54df365cc48f14a514b63616ff7a6d052b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Oct 30 23:30:50 2021 +0200

    home: import: Factorize triplicated 'version-spec' procedure.
    
    * guix/scripts/package.scm (manifest-entry-version-prefix): New
    procedure, moved from...
    (export-manifest)[version-spec]: ... here.  Adjust caller.
    * tests/home-import.scm (version-spec): Remove.
    (eval-test-with-home-environment): Use 'manifest-entry-version-prefix'
    instead.
    * guix/scripts/home/import.scm (import-manifest): Likewise.
---
 guix/scripts/home/import.scm | 23 ++--------------------
 guix/scripts/package.scm     | 47 ++++++++++++++++++++++++--------------------
 tests/home-import.scm        | 26 ++++--------------------
 3 files changed, 32 insertions(+), 64 deletions(-)

diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index a51f7f5..8f6b3b5 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -22,6 +22,7 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix packages)
+  #:autoload   (guix scripts package) (manifest-entry-version-prefix)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
@@ -241,28 +242,8 @@ containing PACKAGES, or SPECS (package specifications), 
and SERVICES."
           manifest destination-directory
           #:optional (port (current-output-port)))
   "Write to PORT a <home-environment> corresponding to MANIFEST."
-  (define (version-spec entry)
-    (let ((name (manifest-entry-name entry)))
-      (match (map package-version (find-packages-by-name name))
-        ((_)
-         ;; A single version of NAME is available, so do not specify the
-         ;; version number, even if the available version doesn't match ENTRY.
-         "")
-        (versions
-         ;; If ENTRY uses the latest version, don't specify any version.
-         ;; Otherwise return the shortest unique version prefix.  Note that
-         ;; this is based on the currently available packages, which could
-         ;; differ from the packages available in the revision that was used
-         ;; to build MANIFEST.
-         (let ((current (manifest-entry-version entry)))
-           (if (every (cut version>? current <>)
-                      (delete current versions))
-               ""
-               (version-unique-prefix (manifest-entry-version entry)
-                                      versions)))))))
-
   (match (manifest->code manifest destination-directory
-                         #:entry-package-version version-spec
+                         #:entry-package-version manifest-entry-version-prefix
                          #:home-environment? #t)
     (('begin exp ...)
      (format port (G_ "\
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index a34ecdc..4b9c5f2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -68,6 +68,7 @@
             guix-package
 
             search-path-environment-variables
+            manifest-entry-version-prefix
 
             transaction-upgrade-entry             ;mostly for testing
 
@@ -327,31 +328,35 @@ Alternately, see @command{guix package --search-paths -p 
~s}.")
 ;;; Export a manifest.
 ;;;
 
+(define (manifest-entry-version-prefix entry)
+  "Search among all the versions of ENTRY's package that are available, and
+return the shortest unambiguous version prefix for this package.  If only one
+version of ENTRY's package is available, return the empty string."
+  (let ((name (manifest-entry-name entry)))
+    (match (map package-version (find-packages-by-name name))
+      ((_)
+       ;; A single version of NAME is available, so do not specify the
+       ;; version number, even if the available version doesn't match ENTRY.
+       "")
+      (versions
+       ;; If ENTRY uses the latest version, don't specify any version.
+       ;; Otherwise return the shortest unique version prefix.  Note that
+       ;; this is based on the currently available packages, which could
+       ;; differ from the packages available in the revision that was used
+       ;; to build MANIFEST.
+       (let ((current (manifest-entry-version entry)))
+         (if (every (cut version>? current <>)
+                    (delete current versions))
+             ""
+             (version-unique-prefix (manifest-entry-version entry)
+                                    versions)))))))
+
 (define* (export-manifest manifest
                           #:optional (port (current-output-port)))
   "Write to PORT a manifest corresponding to MANIFEST."
-  (define (version-spec entry)
-    (let ((name (manifest-entry-name entry)))
-      (match (map package-version (find-packages-by-name name))
-        ((_)
-         ;; A single version of NAME is available, so do not specify the
-         ;; version number, even if the available version doesn't match ENTRY.
-         "")
-        (versions
-         ;; If ENTRY uses the latest version, don't specify any version.
-         ;; Otherwise return the shortest unique version prefix.  Note that
-         ;; this is based on the currently available packages, which could
-         ;; differ from the packages available in the revision that was used
-         ;; to build MANIFEST.
-         (let ((current (manifest-entry-version entry)))
-           (if (every (cut version>? current <>)
-                      (delete current versions))
-               ""
-               (version-unique-prefix (manifest-entry-version entry)
-                                      versions)))))))
-
   (match (manifest->code manifest
-                         #:entry-package-version version-spec)
+                         #:entry-package-version
+                         manifest-entry-version-prefix)
     (('begin exp ...)
      (format port (G_ "\
 ;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
diff --git a/tests/home-import.scm b/tests/home-import.scm
index 40d9547..dc413d8 100644
--- a/tests/home-import.scm
+++ b/tests/home-import.scm
@@ -24,6 +24,8 @@
   #:use-module (ice-9 match)
   #:use-module ((guix profiles) #:hide (manifest->code))
   #:use-module ((guix build syscalls) #:select (mkdtemp!))
+  #:use-module ((guix scripts package)
+                #:select (manifest-entry-version-prefix))
   #:use-module (gnu packages)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -81,33 +83,13 @@ corresponding file."
               ((file . content) (create-file file content)))
             files-alist))
 
-;; Copied from (guix profiles)
-(define (version-spec entry)
-  (let ((name (manifest-entry-name entry)))
-    (match (map package-version (find-packages-by-name name))
-      ((_)
-       ;; A single version of NAME is available, so do not specify the
-       ;; version number, even if the available version doesn't match ENTRY.
-       "")
-      (versions
-       ;; If ENTRY uses the latest version, don't specify any version.
-       ;; Otherwise return the shortest unique version prefix.  Note that
-       ;; this is based on the currently available packages, which could
-       ;; differ from the packages available in the revision that was used
-       ;; to build MANIFEST.
-       (let ((current (manifest-entry-version entry)))
-         (if (every (cut version>? current <>)
-                    (delete current versions))
-             ""
-             (version-unique-prefix (manifest-entry-version entry)
-                                    versions)))))))
-
 (define (eval-test-with-home-environment files-alist manifest matcher)
   (create-temporary-home files-alist)
   (setenv "HOME" %temporary-home-directory)
   (mkdir-p %temporary-home-directory)
   (let* ((home-environment (manifest->code manifest %destination-directory
-                                           #:entry-package-version version-spec
+                                           #:entry-package-version
+                                           manifest-entry-version-prefix
                                            #:home-environment? #t))
          (result (matcher home-environment)))
     (delete-file-recursively %temporary-home-directory)