diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | ccwl/graphviz.scm | 165 | ||||
| -rw-r--r-- | ccwl/utils.scm | 7 | ||||
| -rw-r--r-- | ccwl/yaml.scm | 5 |
4 files changed, 173 insertions, 6 deletions
diff --git a/Makefile.am b/Makefile.am index d143f48..dd5d638 100644 --- a/Makefile.am +++ b/Makefile.am @@ -73,7 +73,7 @@ godir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache bin_SCRIPTS = scripts/ccwl -SOURCES = ccwl/ccwl.scm ccwl/cwl.scm ccwl/yaml.scm ccwl/utils.scm +SOURCES = ccwl/ccwl.scm ccwl/cwl.scm ccwl/graphviz.scm ccwl/yaml.scm ccwl/utils.scm TEST_EXTENSIONS = .scm SCM_TESTS = tests/ccwl.scm tests/utils.scm tests/yaml.scm TESTS = $(SCM_TESTS) diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm new file mode 100644 index 0000000..17650cf --- /dev/null +++ b/ccwl/graphviz.scm @@ -0,0 +1,165 @@ +;;; ccwl --- Concise Common Workflow Language +;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of ccwl. +;;; +;;; ccwl is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; ccwl is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file implements conversion from ccwl objects (<workflow>, +;; <command>, <input>, <output>, <step>) to graphviz. + +;;; Code: + +(define-module (ccwl graphviz) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-28) + #:use-module (ice-9 match) + #:use-module (ccwl ccwl) + #:use-module (ccwl utils) + #:export (workflow->graphviz)) + +(define (workflow->graphviz workflow port) + "Render WORKFLOW, a <workflow> object, to PORT in the graphviz +language." + (graph->graphviz (workflow->graph workflow) + port)) + +(define-immutable-record-type <graph> + (make-graph name properties nodes edges subgraphs) + graph? + (name graph-name) + (properties graph-properties) + (nodes graph-nodes) + (edges graph-edges) + (subgraphs graph-subgraphs)) + +(define* (graph name #:key (properties '()) (nodes '()) (edges '()) (subgraphs '())) + "Construct <graph> object." + (make-graph name properties nodes edges subgraphs)) + +(define-immutable-record-type <graph-node> + (make-graph-node name properties) + graph-node? + (name graph-node-name) + (properties graph-node-properties)) + +(define* (graph-node name #:optional (properties '())) + "Construct <graph-node> object." + (make-graph-node name properties)) + +(define (workflow->graph workflow) + "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")))) + (workflow-steps workflow)) + #:edges (append + ;; Connect steps and inputs to steps. + (append-map (lambda (step) + (map (match-lambda + ((_ . address) + (cons (string->symbol + (match (string-split address #\/) + ((step _) step) + ((workflow-input) workflow-input))) + (step-id step)))) + (step-in step))) + (workflow-steps workflow)) + ;; Connect output sources to outputs. + (map (lambda (output) + (cons (match (string-split (output-source output) #\/) + ((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)))))) + +(define (escape-id id) + "Escape string ID if necessary according to graphviz syntax." + (let ((id (if (symbol? id) + (symbol->string id) + id))) + (if (string-every (char-set-union (char-set-intersection char-set:letter+digit + char-set:ascii) + (char-set #\_)) + id) + id + (call-with-output-string + (cut write id <>))))) + +(define* (graph->graphviz graph #:optional (port (current-output-port)) (level 0)) + "Render GRAPH, a <graph> object, in graphviz syntax to PORT." + (indent-level port level) + (display (format "~a ~a {~%" + (if (zero? level) "digraph" "subgraph") + (graph-name graph)) + port) + (for-each (match-lambda + ((key . value) + (indent-level port (1+ level)) + (display (format "~a=~a;~%" key (escape-id value)) port))) + (graph-properties graph)) + (for-each (lambda (node) + (indent-level port (1+ level)) + (display (escape-id (graph-node-name node)) port) + (unless (null? (graph-node-properties node)) + (display (format " [~a]" + (string-join (map (match-lambda + ((key . value) + (format "~a=~a" key (escape-id value)))) + (graph-node-properties node)) + ", ")) + port)) + (display (format ";~%") port)) + (graph-nodes graph)) + (for-each (match-lambda + ((from . to) + (indent-level port (1+ level)) + (display (format "~a -> ~a;~%" + (escape-id from) + (escape-id to)) + port))) + (graph-edges graph)) + (for-each (lambda (subgraph) + (graph->graphviz subgraph port (1+ level))) + (graph-subgraphs graph)) + (indent-level port level) + (display (format "}~%") port)) diff --git a/ccwl/utils.scm b/ccwl/utils.scm index f7c1e14..c714ce4 100644 --- a/ccwl/utils.scm +++ b/ccwl/utils.scm @@ -27,7 +27,8 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-71) #:use-module (ice-9 match) - #:export (pairify + #:export (indent-level + pairify plist->alist lambda** syntax-lambda** @@ -36,6 +37,10 @@ foldn filter-mapi)) +(define (indent-level port level) + "Emit whitespaces to PORT corresponding to nesting LEVEL." + (display (make-string (* 2 level) #\space) port)) + (define (pairify lst) "Return a list of pairs of successive elements of LST. For example, diff --git a/ccwl/yaml.scm b/ccwl/yaml.scm index 256ba1d..8a2b7a5 100644 --- a/ccwl/yaml.scm +++ b/ccwl/yaml.scm @@ -30,6 +30,7 @@ (define-module (ccwl yaml) #:use-module (srfi srfi-26) #:use-module (ice-9 match) + #:use-module (ccwl utils) #:export (scm->yaml scm->yaml-string)) @@ -55,10 +56,6 @@ (display (if atom "true" "false") port)) (else (error "Unknown atom" atom)))) -(define (indent-level port level) - "Emit whitespaces to PORT corresponding to nesting LEVEL." - (display (make-string (* 2 level) #\space) port)) - (define (display-array-element element port level) "Display array ELEMENT to PORT at nesting LEVEL." (display "- " port) |