summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-10-31 00:02:27 +0200
committerLudovic Courtès <ludo@gnu.org>2021-10-31 00:51:06 +0200
commit6f4ca78761471602e3af37ee1a33de446114039f (patch)
tree93183c29a4e162eec4a63990076afc1da4c21420 /guix
parent96728c54df365cc48f14a514b63616ff7a6d052b (diff)
home: import: Avoid duplication of 'manifest->code'.
* guix/scripts/home/import.scm (manifest->code): Remove. (manifest+configuration-files->code): New procedure. (import-manifest): Use 'manifest+configuration-files->code' instead of 'manifest->code'. * tests/home-import.scm (eval-test-with-home-environment): Likewise. (match-home-environment-transformations): New procedure. ("manifest->code: No services, package transformations"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/home/import.scm176
1 files changed, 40 insertions, 136 deletions
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 8f6b3b58aa..7a7712dd96 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,7 +32,7 @@
#:export (import-manifest
;; For tests.
- manifest->code))
+ manifest+configuration-files->code))
;;; Commentary:
;;;
@@ -105,146 +106,49 @@ in CONFIGURATION-DIRECTORY."
(map (lambda (proc) (proc configuration-directory)) configurations))
-;; Based on `manifest->code' from (guix profiles)
-;; MAYBE: Upstream it?
-(define* (manifest->code manifest destination-directory
- #:key
- (entry-package-version (const ""))
- (home-environment? #f))
- "Return an sexp representing code to build an approximate version of
-MANIFEST; the code is wrapped in a top-level 'begin' form. If
-HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
-Call ENTRY-PACKAGE-VERSION to determine the version number to use in
-the spec for a given entry; it can be set to 'manifest-entry-version'
-for fully-specified version numbers, or to some other procedure to
-disambiguate versions for packages for which several versions are
-available."
- (define (entry-transformations entry)
- ;; Return the transformations that apply to ENTRY.
- (assoc-ref (manifest-entry-properties entry) 'transformations))
-
- (define transformation-procedures
- ;; List of transformation options/procedure name pairs.
- (let loop ((entries (manifest-entries manifest))
- (counter 1)
- (result '()))
- (match entries
- (() result)
- ((entry . tail)
- (match (entry-transformations entry)
- (#f
- (loop tail counter result))
- (options
- (if (assoc-ref result options)
- (loop tail counter result)
- (loop tail (+ 1 counter)
- (alist-cons options
- (string->symbol
- (format #f "transform~a" counter))
- result)))))))))
-
- (define (qualified-name entry)
- ;; Return the name of ENTRY possibly with "@" followed by a version.
- (match (entry-package-version entry)
- ("" (manifest-entry-name entry))
- (version (string-append (manifest-entry-name entry)
- "@" version))))
-
- (if (null? transformation-procedures)
- (let ((specs (map (lambda (entry)
- (match (manifest-entry-output entry)
- ("out" (qualified-name entry))
- (output (string-append (qualified-name entry)
- ":" output))))
- (manifest-entries manifest))))
- (if home-environment?
- (let ((configurations+modules
- (configurations+modules destination-directory)))
- `(begin
- (use-modules (gnu home)
- (gnu packages)
- (gnu services)
- ,@((compose delete-duplicates concatenate)
- (map cdr configurations+modules)))
- ,(home-environment-template
- #:specs specs
- #:services (map first configurations+modules))))
- `(begin
- (use-modules (gnu packages))
-
- (specifications->manifest
- (list ,@specs)))))
- (let* ((transform (lambda (options exp)
- (if (not options)
- exp
- (let ((proc (assoc-ref transformation-procedures
- options)))
- `(,proc ,exp)))))
- (packages (map (lambda (entry)
- (define options
- (entry-transformations entry))
-
- (define name
- (qualified-name entry))
-
- (match (manifest-entry-output entry)
- ("out"
- (transform options
- `(specification->package ,name)))
- (output
- `(list ,(transform
- options
- `(specification->package ,name))
- ,output))))
- (manifest-entries manifest)))
- (transformations (map (match-lambda
- ((options . name)
- `(define ,name
- (options->transformation ',options))))
- transformation-procedures)))
- (if home-environment?
- (let ((configurations+modules
- (configurations+modules destination-directory)))
- `(begin
- (use-modules (guix transformations)
- (gnu home)
- (gnu packages)
- (gnu services)
- ,@((compose delete-duplicates concatenate)
- (map cdr configurations+modules)))
-
- ,@transformations
-
- ,(home-environment-template
- #:packages packages
- #:services (map first configurations+modules))))
- `(begin
- (use-modules (guix transformations)
- (gnu packages))
-
- ,@transformations
-
- (packages->manifest
- (list ,@packages)))))))
-
-(define* (home-environment-template #:key (packages #f) (specs #f) services)
- "Return an S-exp containing a <home-environment> declaration
-containing PACKAGES, or SPECS (package specifications), and SERVICES."
- `(home-environment
- (packages
- ,@(if packages
- `((list ,@packages))
- `((map specification->package
- (list ,@specs)))))
- (services (list ,@services))))
+(define (manifest+configuration-files->code manifest
+ configuration-directory)
+ "Read MANIFEST and the user's configuration files listed in
+%FILES+CONFIGURATIONS-ALIST, and return a 'home-environment' sexp. Copy the
+user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them."
+ (match (manifest->code manifest
+ #:entry-package-version
+ manifest-entry-version-prefix)
+ (('begin ('use-modules profile-modules ...)
+ definitions ... ('packages->manifest packages))
+ (match (configurations+modules configuration-directory)
+ (((services . modules) ...)
+ `(begin
+ (use-modules (gnu home)
+ (gnu packages)
+ (gnu services)
+ ,@(delete-duplicates
+ (append profile-modules (concatenate modules))))
+
+ ,@definitions
+
+ (home-environment
+ (packages ,packages)
+ (services (list ,@services)))))))
+ (('begin ('specifications->manifest packages))
+ (match (configurations+modules configuration-directory)
+ (((services . modules) ...)
+ `(begin
+ (use-modules (gnu home)
+ (gnu packages)
+ (gnu services)
+ ,@(delete-duplicates (concatenate modules)))
+
+ (home-environment
+ (packages (map specification->package ,packages))
+ (services (list ,@services)))))))))
(define* (import-manifest
manifest destination-directory
#:optional (port (current-output-port)))
"Write to PORT a <home-environment> corresponding to MANIFEST."
- (match (manifest->code manifest destination-directory
- #:entry-package-version manifest-entry-version-prefix
- #:home-environment? #t)
+ (match (manifest+configuration-files->code manifest
+ destination-directory)
(('begin exp ...)
(format port (G_ "\
;; This \"home-environment\" file can be passed to 'guix home reconfigure'