graph: Add "list-backend" and "backend" options.

* guix/graph.scm (%graph-backends): New variable.
* guix/scripts/graph.scm (lookup-backend, list-backends): New
procedures.
(%options): Add options for "backend" and "list-backends".
(show-help): Add help texts for "backend" and "list-backend" options.
(%default-options): Add "backend" default.
(guix-graph): Pass backend argument to "export-graph".
* doc/guix.texi (Invoking guix graph): Document the new options.

1 files changed, 34 insertions, 2 deletions

diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 2f70d64c90..d96df5fbaf 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -337,6 +337,13 @@ substitutes."
             %node-types)
       (leave (_ "~a: unknown node type~%") name)))
 
+(define (lookup-backend name)
+  "Return the graph backend called NAME.  Raise an error if it is not found."
+  (or (find (lambda (backend)
+              (string=? (graph-backend-name backend) name))
+            %graph-backends)
+      (leave (_ "~a: unknown backend~%") name)))
+
 (define (list-node-types)
   "Print the available node types along with their synopsis."
   (display (_ "The available node types are:\n"))
@@ -347,6 +354,16 @@ substitutes."
                       (node-type-description type)))
             %node-types))
 
+(define (list-backends)
+  "Print the available backends along with their synopsis."
+  (display (_ "The available backend types are:\n"))
+  (newline)
+  (for-each (lambda (backend)
+              (format #t "  - ~a: ~a~%"
+                      (graph-backend-name backend)
+                      (graph-backend-description backend)))
+            %graph-backends))
+
 
 ;;;
 ;;; Command-line options.
@@ -361,6 +378,14 @@ substitutes."
                 (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)))
@@ -378,6 +403,10 @@ substitutes."
   (display (_ "Usage: guix graph PACKAGE...
 Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
   (display (_ "
+  -b, --backend=TYPE     produce a graph with the given backend TYPE"))
+  (display (_ "
+      --list-backends    list the available graph backends"))
+  (display (_ "
   -t, --type=TYPE        represent nodes of the given TYPE"))
   (display (_ "
       --list-types       list the available graph types"))
@@ -392,7 +421,8 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
   (show-bug-report-information))
 
 (define %default-options
-  `((node-type . ,%package-node-type)))
+  `((node-type . ,%package-node-type)
+    (backend   . ,%graphviz-backend)))
 
 
 ;;;
@@ -407,6 +437,7 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
                                  (lambda (arg result)
                                    (alist-cons 'argument arg result))
                                  %default-options))
+           (backend  (assoc-ref opts 'backend))
            (type     (assoc-ref opts 'node-type))
            (items    (filter-map (match-lambda
                                    (('argument . (? store-path? item))
@@ -429,7 +460,8 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n"))
                                              items)))
               (export-graph (concatenate nodes)
                             (current-output-port)
-                            #:node-type type)))))))
+                            #:node-type type
+                            #:backend backend)))))))
   #t)
 
 ;;; graph.scm ends here