From 3e962e59d849e4300e447d94487684102d9d412e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 7 Nov 2019 18:15:55 +0100
Subject: 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.
---
 guix/scripts/graph.scm | 105 ++++++++++++++++++++++++++++---------------------
 1 file changed, 60 insertions(+), 45 deletions(-)

(limited to 'guix')

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))
-- 
cgit v1.2.3