diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-10-30 23:30:50 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-10-31 00:51:06 +0200 |
commit | 96728c54df365cc48f14a514b63616ff7a6d052b (patch) | |
tree | b864c2a72312a2fe77019f4744d3b95b886fdae5 | |
parent | f3933ae40d4192fa3aeff95ac768bab86ade766f (diff) | |
download | guix-96728c54df365cc48f14a514b63616ff7a6d052b.tar.gz |
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.
-rw-r--r-- | guix/scripts/home/import.scm | 23 | ||||
-rw-r--r-- | guix/scripts/package.scm | 47 | ||||
-rw-r--r-- | 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 a51f7f504b..8f6b3b58aa 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 a34ecdcb54..4b9c5f210d 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 40d9547e8b..dc413d8516 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) |