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.

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 <ludo@gnu.org>
+# Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
 #
 # 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