From 51377437a1e37c9d5f2e137528e9c278b252d781 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 20 Oct 2016 08:47:03 +0200 Subject: [PATCH] graph: Backend must have name and description. * guix/graph.scm (): Add fields "name" and "description". (%graphviz-backend): Provide values for name and description. (export-graph): Ignore name and description when matching backends. (graph-backend-name, graph-backend-description): New procedures. * tests/graph.scm (make-recording-backend): Initialize name and description fields of test graph-backend. --- guix/graph.scm | 20 +++++++++++++------- tests/graph.scm | 3 ++- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/guix/graph.scm b/guix/graph.scm index 735d340c2c..5cf98f0d54 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -44,6 +44,8 @@ %graphviz-backend graph-backend? graph-backend + graph-backend-name + graph-backend-description export-graph)) @@ -140,12 +142,14 @@ typically returned by 'node-edges' or 'node-back-edges'." ;;; (define-record-type - (graph-backend prologue epilogue node edge) + (graph-backend name description prologue epilogue node edge) graph-backend? - (prologue graph-backend-prologue) - (epilogue graph-backend-epilogue) - (node graph-backend-node) - (edge graph-backend-edge)) + (name graph-backend-name) + (description graph-backend-description) + (prologue graph-backend-prologue) + (epilogue graph-backend-epilogue) + (node graph-backend-node) + (edge graph-backend-edge)) (define %colors ;; See colortbl.h in Graphviz. @@ -170,7 +174,9 @@ typically returned by 'node-edges' or 'node-back-edges'." id1 id2 (pop-color id1))) (define %graphviz-backend - (graph-backend emit-prologue emit-epilogue + (graph-backend "graphviz" + "Generate graph in DOT format for use with Graphviz." + emit-prologue emit-epilogue emit-node emit-edge)) (define* (export-graph sinks port @@ -181,7 +187,7 @@ typically returned by 'node-edges' or 'node-back-edges'." given BACKEND. Use NODE-TYPE to traverse the DAG. When REVERSE-EDGES? is true, draw reverse arrows." (match backend - (($ emit-prologue emit-epilogue emit-node emit-edge) + (($ _ _ emit-prologue emit-epilogue emit-node emit-edge) (emit-prologue (node-type-name node-type) port) (match node-type diff --git a/tests/graph.scm b/tests/graph.scm index f2e441cee6..bc4d62fe50 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -57,7 +57,8 @@ edges." (define (return) (values (reverse nodes) (reverse edges))) - (values (graph-backend (const #t) (const #t) + (values (graph-backend "test" "This is the test backend." + (const #t) (const #t) record-node record-edge) return)))