From 3e962e59d849e4300e447d94487684102d9d412e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 7 Nov 2019 18:15:55 +0100 Subject: [PATCH] graph: Support package transformation options. * guix/scripts/graph.scm (%options): Append %TRANSFORMATION-OPTIONS. (show-help): Call 'show-transformation-options-help'. (guix-graph): Call 'options->transformation' and use it. * tests/guix-graph.sh: Add test. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 11 +++++ guix/scripts/graph.scm | 105 +++++++++++++++++++++++------------------ tests/guix-graph.sh | 8 +++- 3 files changed, 78 insertions(+), 46 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3a9d206b9f..3b8e5935bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9907,7 +9907,18 @@ The package dependency graph is largely architecture-independent, but there are some architecture-dependent bits that this option allows you to visualize. @end table +On top of that, @command{guix graph} supports all the usual package +transformation options (@pxref{Package Transformation Options}). This +makes it easy to view the effect of a graph-rewriting transformation +such as @option{--with-input}. For example, the command below outputs +the graph of @code{git} once @code{openssl} has been replaced by +@code{libressl} everywhere in the graph: +@example +guix graph git --with-input=openssl=libressl +@end example + +So many possibilities, so much fun! @node Invoking guix publish @section Invoking @command{guix publish} diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 2e14857f1e..7558cb1e85 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -32,6 +32,10 @@ #:use-module (gnu packages) #:use-module (guix sets) #:use-module ((guix utils) #:select (location-file)) + #:use-module ((guix scripts build) + #:select (show-transformation-options-help + options->transformation + %transformation-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -446,36 +450,38 @@ package modules, while attempting to retain user package modules." ;;; (define %options - (list (option '(#\t "type") #t #f - (lambda (opt name arg result) - (alist-cons 'node-type (lookup-node-type arg) - result))) - (option '("list-types") #f #f - (lambda (opt name arg result) - (list-node-types) - (exit 0))) - (option '(#\b "backend") #t #f - (lambda (opt name arg result) - (alist-cons 'backend (lookup-backend arg) - result))) - (option '("list-backends") #f #f - (lambda (opt name arg result) - (list-backends) - (exit 0))) - (option '(#\e "expression") #t #f - (lambda (opt name arg result) - (alist-cons 'expression arg result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix edit"))))) + (cons* (option '(#\t "type") #t #f + (lambda (opt name arg result) + (alist-cons 'node-type (lookup-node-type arg) + result))) + (option '("list-types") #f #f + (lambda (opt name arg result) + (list-node-types) + (exit 0))) + (option '(#\b "backend") #t #f + (lambda (opt name arg result) + (alist-cons 'backend (lookup-backend arg) + result))) + (option '("list-backends") #f #f + (lambda (opt name arg result) + (list-backends) + (exit 0))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix graph"))) + + %transformation-options)) (define (show-help) ;; TRANSLATORS: Here 'dot' is the name of a program; it must not be @@ -495,6 +501,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (display (G_ " -s, --system=SYSTEM consider the graph for SYSTEM--e.g., \"i686-linux\"")) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -514,21 +522,28 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (define (guix-graph . args) (with-error-handling - (let* ((opts (parse-command-line args %options - (list %default-options) - #:build-options? #f)) - (backend (assoc-ref opts 'backend)) - (type (assoc-ref opts 'node-type)) - (items (filter-map (match-lambda - (('argument . (? store-path? item)) - item) - (('argument . spec) - (specification->package spec)) - (('expression . exp) - (read/eval-package-expression exp)) - (_ #f)) - opts))) - (with-store store + (define opts + (parse-command-line args %options + (list %default-options) + #:build-options? #f)) + (define backend + (assoc-ref opts 'backend)) + (define type + (assoc-ref opts 'node-type)) + + (with-store store + (let* ((transform (options->transformation opts)) + (items (filter-map (match-lambda + (('argument . (? store-path? item)) + item) + (('argument . spec) + (transform store + (specification->package spec))) + (('expression . exp) + (transform store + (read/eval-package-expression exp))) + (_ #f)) + opts))) ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 1ec99706fd..2d4b3fac3f 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016 Ludovic Courtès +# Copyright © 2015, 2016, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -53,3 +53,9 @@ cmp "$tmpfile1" "$tmpfile2" guix graph -t derivation coreutils > "$tmpfile1" guix graph -t derivation `guix build -d coreutils` > "$tmpfile2" cmp "$tmpfile1" "$tmpfile2" + +# Try package transformation options. +guix graph git | grep 'label = "openssl' +guix graph git --with-input=openssl=libressl | grep 'label = "libressl' +if guix graph git --with-input=openssl=libressl | grep 'label = "openssl' +then false; else true; fi