me/guix
Archived
1
0
Fork 0
Code Activity

home: import: Factorize triplicated 'version-spec' procedure.

Browse source 
* 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:
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 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_ "\

47
guix/scripts/package.scm
View file

@ -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,31 +328,35 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
;;; Export a manifest. ;;; 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 (define* (export-manifest manifest
#:optional (port (current-output-port))) #:optional (port (current-output-port)))
"Write to PORT a manifest corresponding to MANIFEST." "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 (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

26
tests/home-import.scm
View file

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