Subject: [PATCH 1/1] guix: graph: Add Trival Graph Format (TGF) backend.
From: Hartmut Goebel <[email-masked]>
To: [email-masked]
Date: Mon, 5 Mar 2018 12:41:36 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

* guix/graph.scm ((emit-edge, emit-d3js-edge, emit-cypher-edge): New arguments
  label1 , label2.
  (emit-tg-progloug, mit-tgf-epilouge, emit-tgf-node, emit-tgf-edge): New
  variables.
  (%trivial-graph-backend): New variable.
  (%graph-backends): Add %trivial-graph-backend.
  (export-graph): Pass labels to emit-edge.
---
 guix/graph.scm | 40 ++++++++++++++++++++++++++++++++++------
 1 file changed, 34 insertions(+), 6 deletions(-)

diff --git a/guix/graph.scm b/guix/graph.scm
index d7fd5f3e4..650d577f6 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -46,6 +46,7 @@
             %graph-backends
             %d3js-backend
             %graphviz-backend
+            %trival-graph-backend
             graph-backend?
             graph-backend
             graph-backend-name
@@ -173,7 +174,7 @@ typically returned by 'node-edges' or 'node-back-edges'."
 (define (emit-node id label port)
   (format port "  \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%"
           id label))
-(define (emit-edge id1 id2 port)
+(define (emit-edge id1 label1 id2 label2 port)
   (format port "  \"~a\" -> \"~a\" [color = ~a];~%"
           id1 id2 (pop-color id1)))
 
@@ -219,7 +220,7 @@ nodes[\"~a\"] = {\"id\": \"~a\", \"label\": \"~a\", \"index\": nodeArray.length}
 nodeArray.push(nodes[\"~a\"]);~%"
           id id label id))
 
-(define (emit-d3js-edge id1 id2 port)
+(define (emit-d3js-edge id1 label1 id2 label2 port)
   (format port "links.push({\"source\": \"~a\", \"target\": \"~a\"});~%"
           id1 id2))
 
@@ -245,7 +246,7 @@ nodeArray.push(nodes[\"~a\"]);~%"
   (format port "MERGE (p:Package { id: ~s }) SET p.name = ~s;~%"
           id label ))
 
-(define (emit-cypher-edge id1 id2 port)
+(define (emit-cypher-edge id1 label1 id2 label2 port)
   (format port "MERGE (a:Package { id: ~s });~%" id1)
   (format port "MERGE (b:Package { id: ~s });~%" id2)
   (format port "MATCH (a:Package { id: ~s }), (b:Package { id: ~s }) CREATE UNIQUE (a)-[:NEEDS]->(b);~%"
@@ -260,13 +261,32 @@ nodeArray.push(nodes[\"~a\"]);~%"
 
 
 ;;;
+;;; Trivial graph export.
+;;;
+
+(define (emit-tgf-prologue name port) #t)
+(define (emit-tgf-epilogue port) #t)
+(define (emit-tgf-node id label port) #t)
+(define (emit-tgf-edge id1 label1 id2 label2 port)
+  (format port "~a ~a~%" label1 label2))
+
+(define %trival-graph-backend
+  (graph-backend "tgf"
+                 "Generate graph in Trivial Graph Format."
+                 emit-tgf-prologue emit-tgf-epilogue
+                 emit-tgf-node emit-tgf-edge))
+
+
+
+;;;
 ;;; Shared.
 ;;;
 
 (define %graph-backends
   (list %graphviz-backend
         %d3js-backend
-        %cypher-backend))
+        %cypher-backend
+        %trival-graph-backend))
 
 (define* (export-graph sinks port
                        #:key
@@ -299,8 +319,16 @@ true, draw reverse arrows."
                      (emit-node id (node-label head) port)
                      (for-each (lambda (dependency dependency-id)
                                  (if reverse-edges?
-                                     (emit-edge dependency-id id port)
-                                     (emit-edge id dependency-id port)))
+                                     (emit-edge dependency-id
+                                                (node-label dependency)
+                                                id
+                                                (node-label head)
+                                                port)
+                                     (emit-edge id
+                                                (node-label head)
+                                                dependency-id
+                                                (node-label dependency)
+                                                port)))
                                dependencies ids)
                      (loop (append dependencies tail)
                            (set-insert id visited)))))))))))))
-- 
2.13.6