summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-09-28 23:43:21 +0100
committerArun Isaac2023-09-28 23:46:20 +0100
commit9dbb8a48d838ec1fc51c4770cb25741d4a173081 (patch)
treeffe8dc1d856730b0efa2cd9be60e76ba41aabc45
parenta5fa8d018e650cf359e4ecd8774c600ccf7cade0 (diff)
downloadccwl-9dbb8a48d838ec1fc51c4770cb25741d4a173081.tar.gz
ccwl-9dbb8a48d838ec1fc51c4770cb25741d4a173081.tar.lz
ccwl-9dbb8a48d838ec1fc51c4770cb25741d4a173081.zip
graphviz: Add command to dot serialization function.
* ccwl/graphviz.scm (step-node, inputs-cluster, outputs-cluster, command->graph): New functions. (workflow->graph): Use step-node, inputs-cluster and outputs-cluster. (command->dot): New public function.
-rw-r--r--ccwl/graphviz.scm97
1 files changed, 69 insertions, 28 deletions
diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm
index 7da0188..2dc4f8d 100644
--- a/ccwl/graphviz.scm
+++ b/ccwl/graphviz.scm
@@ -1,5 +1,5 @@
;;; ccwl --- Concise Common Workflow Language
-;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2021, 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of ccwl.
;;;
@@ -32,7 +32,8 @@
#:use-module (ice-9 string-fun)
#:use-module (ccwl ccwl)
#:use-module (ccwl utils)
- #:export (workflow->dot))
+ #:export (workflow->dot
+ command->dot))
(define (workflow->dot workflow port)
"Render WORKFLOW, a <workflow> object, to PORT in the graphviz dot
@@ -89,11 +90,7 @@ language."
"Convert WORKFLOW, a <workflow> object, to a <graph> object."
(graph 'workflow
#:properties '((bgcolor . "#eeeeee"))
- #:nodes (map (lambda (step)
- (graph-node (step-id step)
- '((fillcolor . "lightgoldenrodyellow")
- (shape . "record")
- (style . "filled"))))
+ #:nodes (map (compose step-node step-id)
(workflow-steps workflow))
#:edges (append
;; Connect steps and inputs to steps.
@@ -113,27 +110,71 @@ language."
((source _) source))
(output-id output)))
(workflow-outputs workflow)))
- #:subgraphs (list (graph 'cluster_inputs
- #:properties '((label . "Workflow Inputs")
- (rank . "same")
- (style . "dashed"))
- #:nodes (map (lambda (input)
- (graph-node (input-id input)
- '((fillcolor . "#94ddf4")
- (shape . "record")
- (style . "filled"))))
- (workflow-inputs workflow)))
- (graph 'cluster_outputs
- #:properties '((label . "Workflow Outputs")
- (labelloc . "b")
- (rank . "same")
- (style . "dashed"))
- #:nodes (map (lambda (output)
- (graph-node (output-id output)
- '((fillcolor . "#94ddf4")
- (shape . "record")
- (style . "filled"))))
- (workflow-outputs workflow))))))
+ #:subgraphs (list (inputs-cluster (workflow-inputs workflow))
+ (outputs-cluster (workflow-outputs workflow)))))
+
+(define (command->dot command port)
+ "Render @var{command}, a @code{<command>} object, to @var{port} in the
+graphviz dot language."
+ (graph->dot (command->graph command)
+ port))
+
+(define (command->graph command)
+ "Convert @var{command}, a @code{<command>} object, to a @code{<graph>}
+object."
+ (graph 'workflow
+ #:properties '((bgcolor . "#eeeeee"))
+ #:nodes (list (graph-node 'command
+ '((fillcolor . "lightgoldenrodyellow")
+ (shape . "record")
+ (style . "filled"))))
+ #:edges (append
+ ;; Connect inputs to command.
+ (map (lambda (input)
+ (cons (input-id input)
+ 'command))
+ (command-inputs command))
+ ;; Connect command to outputs.
+ (map (lambda (output)
+ (cons 'command
+ (output-id output)))
+ (command-outputs command)))
+ #:subgraphs (list (inputs-cluster (command-inputs command))
+ (outputs-cluster (command-outputs command)))))
+
+(define (step-node id)
+ "Return graph node describing step with @var{id}."
+ (graph-node id
+ '((fillcolor . "lightgoldenrodyellow")
+ (shape . "record")
+ (style . "filled"))))
+
+(define (inputs-cluster inputs)
+ "Return the subgraph clustering @var{inputs}."
+ (graph 'cluster_inputs
+ #:properties '((label . "Workflow Inputs")
+ (rank . "same")
+ (style . "dashed"))
+ #:nodes (map (lambda (input)
+ (graph-node (input-id input)
+ '((fillcolor . "#94ddf4")
+ (shape . "record")
+ (style . "filled"))))
+ inputs)))
+
+(define (outputs-cluster outputs)
+ "Return the subgraph clustering @var{outputs}."
+ (graph 'cluster_outputs
+ #:properties '((label . "Workflow Outputs")
+ (labelloc . "b")
+ (rank . "same")
+ (style . "dashed"))
+ #:nodes (map (lambda (output)
+ (graph-node (output-id output)
+ '((fillcolor . "#94ddf4")
+ (shape . "record")
+ (style . "filled"))))
+ outputs)))
(define (serialize object)
"Serialize OBJECT according to graphviz dot syntax. OBJECT may a