diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | ccwl/graphviz.scm | 48 | ||||
| -rw-r--r-- | tests/graphviz.scm | 48 |
3 files changed, 80 insertions, 18 deletions
diff --git a/Makefile.am b/Makefile.am index 9250230..218ccc7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -75,7 +75,7 @@ bin_SCRIPTS = scripts/ccwl 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 +SCM_TESTS = tests/ccwl.scm tests/graphviz.scm tests/utils.scm tests/yaml.scm TESTS = $(SCM_TESTS) SCM_LOG_DRIVER = \ diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm index 7093bdb..fbef971 100644 --- a/ccwl/graphviz.scm +++ b/ccwl/graphviz.scm @@ -62,6 +62,11 @@ language." "Construct <graph-node> object." (make-graph-node name properties)) +(define-immutable-record-type <html-string> + (html-string str) + html-string? + (str html-string-underlying)) + (define (workflow->graph workflow) "Convert WORKFLOW, a <workflow> object, to a <graph> object." (graph 'workflow @@ -112,18 +117,27 @@ language." (style . "filled")))) (workflow-outputs workflow)))))) -(define (escape-id id) - "Escape string ID if necessary according to graphviz dot 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 (serialize object) + "Serialize OBJECT according to graphviz dot syntax. OBJECT may a +symbol, a string, or a <html-string> object." + (let ((str (cond + ((symbol? object) (symbol->string object)) + ((string? object) object) + ((html-string? object) (html-string-underlying object)) + (else (error "Unknown object type to serialize to graphviz dot:" object))))) + (cond + ;; Surround HTML strings in <>, and don't escape. + ((html-string? object) + (format "<~a>" str)) + ;; Don't escape safe strings. + ((string-every (char-set-union (char-set-intersection char-set:letter+digit + char-set:ascii) + (char-set #\_)) + str) + str) + ;; Escape strings with unsafe characters. + (else (call-with-output-string + (cut write str <>)))))) (define* (graph->dot graph #:optional (port (current-output-port)) (level 0)) "Render GRAPH, a <graph> object, in the graphviz dot syntax to @@ -136,16 +150,16 @@ PORT." (for-each (match-lambda ((key . value) (indent-level port (1+ level)) - (display (format "~a=~a;~%" key (escape-id value)) port))) + (display (format "~a=~a;~%" key (serialize value)) port))) (graph-properties graph)) (for-each (lambda (node) (indent-level port (1+ level)) - (display (escape-id (graph-node-name node)) port) + (display (serialize (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)))) + (format "~a=~a" key (serialize value)))) (graph-node-properties node)) ", ")) port)) @@ -155,8 +169,8 @@ PORT." ((from . to) (indent-level port (1+ level)) (display (format "~a -> ~a;~%" - (escape-id from) - (escape-id to)) + (serialize from) + (serialize to)) port))) (graph-edges graph)) (for-each (lambda (subgraph) diff --git a/tests/graphviz.scm b/tests/graphviz.scm new file mode 100644 index 0000000..5853616 --- /dev/null +++ b/tests/graphviz.scm @@ -0,0 +1,48 @@ +;;; 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/>. + +(use-modules (srfi srfi-64)) + +(define graph->dot + (@@ (ccwl graphviz) graph->dot)) + +(define graph + (@@ (ccwl graphviz) graph)) + +(define graph-node + (@@ (ccwl graphviz) graph-node)) + +(define html-string + (@@ (ccwl graphviz) html-string)) + +(test-begin "graphviz") + +(test-equal "serialize HTML strings correctly" + "digraph foo { + bar [label=<<table><tr><td>bar</td></tr></table>>]; +} +" + (call-with-output-string + (lambda (port) + (graph->dot + (graph 'foo + #:nodes (list (graph-node 'bar + `((label . ,(html-string "<table><tr><td>bar</td></tr></table>")))))) + port)))) + +(test-end "graphviz") |