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.
This commit is contained in:
parent
f3933ae40d
commit
96728c54df
3 changed files with 32 additions and 64 deletions
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
|
#:autoload (guix scripts package) (manifest-entry-version-prefix)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 pretty-print)
|
#:use-module (ice-9 pretty-print)
|
||||||
|
@ -241,28 +242,8 @@ containing PACKAGES, or SPECS (package specifications), and SERVICES."
|
||||||
manifest destination-directory
|
manifest destination-directory
|
||||||
#:optional (port (current-output-port)))
|
#:optional (port (current-output-port)))
|
||||||
"Write to PORT a <home-environment> corresponding to MANIFEST."
|
"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
|
(match (manifest->code manifest destination-directory
|
||||||
#:entry-package-version version-spec
|
#:entry-package-version manifest-entry-version-prefix
|
||||||
#:home-environment? #t)
|
#:home-environment? #t)
|
||||||
(('begin exp ...)
|
(('begin exp ...)
|
||||||
(format port (G_ "\
|
(format port (G_ "\
|
||||||
|
|
|
@ -68,6 +68,7 @@
|
||||||
guix-package
|
guix-package
|
||||||
|
|
||||||
search-path-environment-variables
|
search-path-environment-variables
|
||||||
|
manifest-entry-version-prefix
|
||||||
|
|
||||||
transaction-upgrade-entry ;mostly for testing
|
transaction-upgrade-entry ;mostly for testing
|
||||||
|
|
||||||
|
@ -327,10 +328,10 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
|
||||||
;;; Export a manifest.
|
;;; Export a manifest.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define* (export-manifest manifest
|
(define (manifest-entry-version-prefix entry)
|
||||||
#:optional (port (current-output-port)))
|
"Search among all the versions of ENTRY's package that are available, and
|
||||||
"Write to PORT a manifest corresponding to MANIFEST."
|
return the shortest unambiguous version prefix for this package. If only one
|
||||||
(define (version-spec entry)
|
version of ENTRY's package is available, return the empty string."
|
||||||
(let ((name (manifest-entry-name entry)))
|
(let ((name (manifest-entry-name entry)))
|
||||||
(match (map package-version (find-packages-by-name name))
|
(match (map package-version (find-packages-by-name name))
|
||||||
((_)
|
((_)
|
||||||
|
@ -350,8 +351,12 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
|
||||||
(version-unique-prefix (manifest-entry-version entry)
|
(version-unique-prefix (manifest-entry-version entry)
|
||||||
versions)))))))
|
versions)))))))
|
||||||
|
|
||||||
|
(define* (export-manifest manifest
|
||||||
|
#:optional (port (current-output-port)))
|
||||||
|
"Write to PORT a manifest corresponding to MANIFEST."
|
||||||
(match (manifest->code manifest
|
(match (manifest->code manifest
|
||||||
#:entry-package-version version-spec)
|
#:entry-package-version
|
||||||
|
manifest-entry-version-prefix)
|
||||||
(('begin exp ...)
|
(('begin exp ...)
|
||||||
(format port (G_ "\
|
(format port (G_ "\
|
||||||
;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
|
;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
|
||||||
|
|
|
@ -24,6 +24,8 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module ((guix profiles) #:hide (manifest->code))
|
#:use-module ((guix profiles) #:hide (manifest->code))
|
||||||
#:use-module ((guix build syscalls) #:select (mkdtemp!))
|
#:use-module ((guix build syscalls) #:select (mkdtemp!))
|
||||||
|
#:use-module ((guix scripts package)
|
||||||
|
#:select (manifest-entry-version-prefix))
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
@ -81,33 +83,13 @@ corresponding file."
|
||||||
((file . content) (create-file file content)))
|
((file . content) (create-file file content)))
|
||||||
files-alist))
|
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)
|
(define (eval-test-with-home-environment files-alist manifest matcher)
|
||||||
(create-temporary-home files-alist)
|
(create-temporary-home files-alist)
|
||||||
(setenv "HOME" %temporary-home-directory)
|
(setenv "HOME" %temporary-home-directory)
|
||||||
(mkdir-p %temporary-home-directory)
|
(mkdir-p %temporary-home-directory)
|
||||||
(let* ((home-environment (manifest->code manifest %destination-directory
|
(let* ((home-environment (manifest->code manifest %destination-directory
|
||||||
#:entry-package-version version-spec
|
#:entry-package-version
|
||||||
|
manifest-entry-version-prefix
|
||||||
#:home-environment? #t))
|
#:home-environment? #t))
|
||||||
(result (matcher home-environment)))
|
(result (matcher home-environment)))
|
||||||
(delete-file-recursively %temporary-home-directory)
|
(delete-file-recursively %temporary-home-directory)
|
||||||
|
|
Reference in a new issue