From dc5d5cc8a360a07bbc16ebd217d695a0c049daa3 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Fri, 21 Oct 2016 23:59:00 +0200
Subject: [PATCH 2/3] 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".
---
 guix/graph.scm         | 10 ++++++++++
 guix/scripts/graph.scm | 36 ++++++++++++++++++++++++++++++++++--
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/guix/graph.scm b/guix/graph.scm
index 5cf98f0..d2c1fa6 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +42,7 @@
             node-transitive-edges
             node-reachable-count
 
+            %graph-backends
             %graphviz-backend
             graph-backend?
             graph-backend
@@ -179,6 +181,14 @@ typically returned by 'node-edges' or 'node-back-edges'."
                  emit-prologue emit-epilogue
                  emit-node emit-edge))
 
+
+;;;
+;;; Shared.
+;;;
+
+(define %graph-backends
+  (list %graphviz-backend))
+
 (define* (export-graph sinks port
                        #:key
                        reverse-edges? node-type
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 782fca5..ecab92c 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -314,6 +314,13 @@ reference graph")))))))
             %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"))
@@ -324,6 +331,16 @@ reference graph")))))))
                       (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.
@@ -338,6 +355,14 @@ reference graph")))))))
                 (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)))
@@ -355,6 +380,10 @@ reference graph")))))))
   (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"))
@@ -369,7 +398,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)))
 
 
 ;;;
@@ -384,6 +414,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))
@@ -406,7 +437,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
-- 
2.10.0