summaryrefslogtreecommitdiff
path: root/guix/scripts/shell.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-03-31 13:01:21 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-04 22:58:04 +0200
commitc42b7baf13c7633b4512e94da7445299c57b247d (patch)
tree461389e058b7d9499299612593533d72e647a7ea /guix/scripts/shell.scm
parent6fed836a6f9b8fb63ba067d0523942119687ce0b (diff)
shell: Add '--export-manifest'.
* guix/scripts/shell.scm (show-help, %options): Add '--export-manifest'. (manifest-entry-version-prefix, manifest->code*) (export-manifest): New procedures. (guix-shell): Honor '--export-manifest'. * tests/guix-shell-export-manifest.sh: New file. * Makefile.am (SH_TESTS): Add it. * doc/guix.texi (Invoking guix shell): Document '--export-manifest'. (Invoking guix environment): Link to it. (Invoking guix pack): Likewise.
Diffstat (limited to 'guix/scripts/shell.scm')
-rw-r--r--guix/scripts/shell.scm109
1 files changed, 106 insertions, 3 deletions
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 1eab05d737..d9af2517c2 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -21,7 +21,8 @@
#:use-module ((guix diagnostics) #:select (location))
#:use-module (guix scripts environment)
#:autoload (guix scripts build) (show-build-options-help)
- #:autoload (guix transformations) (transformation-option-key?
+ #:autoload (guix transformations) (options->transformation
+ transformation-option-key?
show-transformation-options-help)
#:use-module (guix scripts)
#:use-module (guix packages)
@@ -41,7 +42,12 @@
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module (guix cache)
#:use-module ((ice-9 ftw) #:select (scandir))
- #:autoload (gnu packages) (cache-is-authoritative?)
+ #:autoload (ice-9 pretty-print) (pretty-print)
+ #:autoload (gnu packages) (cache-is-authoritative?
+ package-unique-version-prefix
+ specification->package
+ specification->package+output
+ specifications->manifest)
#:export (guix-shell))
(define (show-help)
@@ -55,10 +61,13 @@ interactive shell in that environment.\n"))
-D, --development include the development inputs of the next package"))
(display (G_ "
-f, --file=FILE add to the environment the package FILE evaluates to"))
+
(display (G_ "
-q inhibit loading of 'guix.scm' and 'manifest.scm'"))
(display (G_ "
--rebuild-cache rebuild cached environment, if any"))
+ (display (G_ "
+ --export-manifest print a manifest for the given options"))
(show-environment-options-help)
(newline)
@@ -112,6 +121,10 @@ interactive shell in that environment.\n"))
;; 'wrapped-option'.
(alist-delete 'ad-hoc? result)))
+ (option '("export-manifest") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'export-manifest? #t result)))
+
;; For consistency with 'guix package', support '-f' rather than
;; '-l' like 'guix environment' does.
(option '(#\f "file") #t #f
@@ -382,6 +395,94 @@ return #f and #f."
;;;
+;;; Exporting 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."
+ (package-unique-version-prefix (manifest-entry-name entry)
+ (manifest-entry-version entry)))
+
+(define (manifest->code* manifest extra-manifests)
+ "Like 'manifest->code', but insert a 'concatenate-manifests' call that
+concatenates MANIFESTS, a list of expressions."
+ (if (null? (manifest-entries manifest))
+ (match extra-manifests
+ ((one) one)
+ (lst `(concatenate-manifests ,@extra-manifests)))
+ (match (manifest->code manifest
+ #:entry-package-version
+ manifest-entry-version-prefix)
+ (('begin exp ... last)
+ `(begin
+ ,@exp
+ ,(match extra-manifests
+ (() last)
+ (_ `(concatenate-manifests
+ (list ,last ,@extra-manifests)))))))))
+
+(define (export-manifest opts port)
+ "Write to PORT a manifest corresponding to OPTS."
+ (define (manifest-lift proc)
+ (lambda (entry)
+ (match (manifest-entry-item entry)
+ ((? package? p)
+ (manifest-entry
+ (inherit (package->manifest-entry (proc p)))
+ (output (manifest-entry-output entry))))
+ (_
+ entry))))
+
+ (define (validated-spec spec)
+ ;; Return SPEC if it's a valid package spec.
+ (specification->package+output spec)
+ spec)
+
+ (let* ((transform (options->transformation opts))
+ (specs (reverse
+ (filter-map (match-lambda
+ (('package 'ad-hoc-package spec)
+ (validated-spec spec))
+ (_ #f))
+ opts)))
+ (extras (reverse
+ (filter-map (match-lambda
+ (('package 'package spec)
+ ;; Make sure SPEC is valid.
+ (specification->package spec)
+
+ ;; XXX: This is an approximation:
+ ;; transformation options are not applied.
+ `(package->development-manifest
+ (specification->package ,spec)))
+ (_ #f))
+ opts)))
+ (manifest (concatenate-manifests
+ (cons (map-manifest-entries
+ (manifest-lift transform)
+ (specifications->manifest specs))
+ (filter-map (match-lambda
+ (('manifest . file)
+ (load-manifest file))
+ (_ #f))
+ opts)))))
+ (display (G_ "\
+;; What follows is a \"manifest\" equivalent to the command line you gave.
+;; You can store it in a file that you may then pass to any 'guix' command
+;; that accepts a '--manifest' (or '-m') option.\n")
+ port)
+ (match (manifest->code* manifest extras)
+ (('begin exp ...)
+ (for-each (lambda (exp)
+ (newline port)
+ (pretty-print exp port))
+ exp))
+ (exp
+ (pretty-print exp port)))))
+
+
+;;;
;;; One-time hints.
;;;
@@ -445,4 +546,6 @@ to make sure your shell does not clobber environment variables."))) )
cache-entries
#:entry-expiration entry-expiration)))
- (guix-environment* opts))
+ (if (assoc-ref opts 'export-manifest?)
+ (export-manifest opts (current-output-port))
+ (guix-environment* opts)))