me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2021-10-30 23:30:50 +02:00
parent f3933ae40d
commit 96728c54df
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 32 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/scripts/home/import.scm
View File

@ -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_ "\

47
guix/scripts/package.scm
View File

@ -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

26
tests/home-import.scm
View File

@ -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)