02/04: graph: Add "list-backend" and "backend" options.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit 642339dc3fc6df33edd78f3cdc170c20a32a3c7d
Author: Ricardo Wurmus <address@hidden>
Date:   Fri Oct 21 23:59:00 2016 +0200

    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.
---
 doc/guix.texi          |    7 +++++++
 guix/graph.scm         |   10 ++++++++++
 guix/scripts/graph.scm |   36 ++++++++++++++++++++++++++++++++++--
 3 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a5424b4..83f5248 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5827,6 +5827,13 @@ the values listed above.
 @item --list-types
 List the supported graph types.
 
address@hidden address@hidden
address@hidden -b @var{backend}
+Produce a graph using the selected @var{backend}.
+
address@hidden --list-backends
+List the supported graph backends.
+
 @item address@hidden
 @itemx -e @var{expr}
 Consider the package @var{expr} evaluates to.
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 <address@hidden>
+;;; Copyright © 2016 Ricardo Wurmus <address@hidden>
 ;;;
 ;;; 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 2f70d64..d96df5f 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