1/* Part of SWISH 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2015-2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(swish_render_graphviz, 36 [ term_rendering//3, % +Term, +Vars, +Options 37 svg//2 % +String, +Options 38 ]). 39:- use_module(library(http/html_write)). 40:- use_module(library(http/js_write)). 41:- use_module(library(http/http_dispatch)). 42:- use_module(library(http/http_parameters)). 43:- use_module(library(http/http_path)). 44:- use_module(library(process)). 45:- use_module(library(sgml)). 46:- use_module(library(debug)). 47:- use_module(library(error)). 48:- use_module(library(option)). 49:- use_module(library(lists)). 50:- use_module(library(apply)). 51:- use_module(library(dcg/basics)). 52:- use_module('../render'). 53 54:- register_renderer(graphviz, "Render data using graphviz").

Render data using graphviz

This renderer exploits graphviz to render graphs from Prolog data. It takes two representations. The first is a straightforward term Program(String), e.g.,

dot("digraph G {Hello->World}")

The second takes a Prolog term as input. The dot language is represented as follows:

Graph      := graph(Statements)
            | graph(Options, Statements)
            | digraph(Statements)
            | digraph(Options, Statements)
Options    := ID | [ID] | [strict, ID]
Statements := List of statements
Statement  := NodeStm | EdgeStm | AttrStm | Name = Value | SubGraph
NodeStm    := NodeID | node(NodeID, AttrList)
NodeID     := ID | ID:Port | ID:Port:CompassPT
CompassPT  := n | ne | e | se | s | sw | w | nw | c | _
EdgeStm    := (NodeID|SubGraph) (EdgeOp (NodeID|SubGraph))+
EdgeStm     | edge(NodeID|SubGraph) (EdgeOp (NodeID|SubGraph))+), AttrList)
EdgeOp     := - | ->
AttrStm    := graph(AttrList)
            | node(AttrList)
            | edge(AttrList)
AttrList   := List of attributes
Attribute  := Name = Value
            | Name(Value)
SubGraph   := subgraph(ID, Statements)

107term_rendering(Data, Vars, Options) --> 108 { debug(graphviz(vars), 'Data: ~q, vars: ~p', [Data, Vars]), 109 data_to_graphviz_string(Data, DOTString, Program) 110 }, 111 render_dot(DOTString, Program, Options).

119render_dot(_DOTString, Program, _Options) --> 120 { \+ has_graphviz_renderer(Program) }, !, 121 no_graph_viz(Program). 122render_dot(DOTString, Program, Options) --> % <object> rendering 123 { option(svg(object), Options, inline), !, 124 variant_sha1(DOTString, Hash), 125 get_time(Now), 126 assert(dot_data(Hash, 127 _{ program: Program, 128 dot: DOTString 129 }, Now)), 130 remove_old_data(Now), 131 http_link_to_id(swish_send_graphviz, 132 [ hash(Hash), 133 lang(svg), 134 target('_top') 135 ], HREF), 136 Attrs = [] % TBD 137 }, !, 138 html([ object([ data(HREF), 139 type('image/svg+xml') 140 | Attrs 141 ], 142 []) 143 ]). 144render_dot(DOTString, Program, _Options) --> % <svg> rendering 145 { graphviz_stream(_{program:Program, dot:DOTString}, 146 PID, XDotOut, ErrorOut), 147 call_cleanup(( read_string(XDotOut, _, SVG), 148 read_string(ErrorOut, _, Error) 149 ), 150 ( process_wait_0(PID), 151 close(ErrorOut, [force(true)]), 152 close(XDotOut) 153 )) 154 }, 155 ( { Error == "" } 156 -> html(div([ class(['render-graphviz', 'reactive-size']), 157 'data-render'('As Graphviz graph') 158 ], 159 \svg(SVG, []))) 160 ; html(div(style('color:red;'), 161 [ '~w'-[Program], ': ', Error])) 162 ). 163 164process_wait_0(PID) :- 165 process_wait(PID, Status), 166 ( Status == exit(0) 167 -> true 168 ; print_message(error, format('Process ~q died on ~q', [PID, Status])) 169 ).

176svg(SVG, _Options) --> 177 html([ \[SVG], 178 \js_script({|javascript|| 179(function() { 180 if ( $.ajaxScript ) { 181 var div = $.ajaxScript.parent(); 182 var svg = div.find("svg"); 183 var data = { w0: svg.width(), 184 h0: svg.height() 185 }; 186 var pan; 187 188 function updateSize() { 189 var w = svg.closest("div.answer").innerWidth(); 190 191 function reactive() { 192 if ( !data.reactive ) { 193 data.reactive = true; 194 div.on("reactive-resize", updateSize); 195 } 196 } 197 198 w = Math.max(w*0.85, 100); 199 if ( w < data.w0 ) { 200 svg.width(w); 201 svg.height(w = Math.max(w*data.h0/data.w0, w/4)); 202 reactive(); 203 if ( pan ) { 204 pan.resize(); 205 pan.fit(); 206 pan.center(); 207 } 208 } 209 } 210 211 require(["svg-pan-zoom"], function(svgPanZoom) { 212 updateSize() 213 pan = svgPanZoom(svg[0], { 214 // controlIconsEnabled: true 215 minZoom: 0.1, 216 maxZoom: 50 217 }); 218 }); 219 } 220 })(); 221 |}) 222 ]).

229data_to_graphviz_string(Compound, String, Program) :- 230 compound(Compound), 231 compound_name_arguments(Compound, Program, [Data]), 232 graphviz_program(Program), 233 ( atomic(Data) 234 -> String = Data 235 ; phrase(graph(Data), Codes), 236 string_codes(String, Codes), 237 debug(graphviz, '~s', [String]) 238 ). 239data_to_graphviz_string(Compound, String, dot) :- 240 compound(Compound), 241 compound_name_arity(Compound, Type, Arity), 242 graph_type(Type), 243 between(1,2,Arity), !, 244 phrase(graph(Compound), Codes), 245 string_codes(String, Codes), 246 debug(graphviz, '~s', [String]). 247 248 249graphviz_program(dot). 250graphviz_program(neato). 251graphviz_program(fdp). 252graphviz_program(sfdp). 253graphviz_program(twopi). 254graphviz_program(circo). 255graphviz_program(osage). 256graphviz_program(patchwork). 257 258graph_type(graph). 259graph_type(digraph).

265swish_send_graphviz(Request) :- 266 http_parameters(Request, 267 [ hash(Hash, 268 [ description('Hash-key to the graph-data') 269 ]) 270 ]), 271 dot_data(Hash, Data, _), 272 graphviz_stream(Data, PID, XDotOut, ErrorOut), 273 call_cleanup(( load_structure(stream(XDotOut), 274 SVGDom0, 275 [ dialect(xml) ]), 276 read_string(ErrorOut, _, Error) 277 ), 278 ( process_wait_0(PID), 279 close(ErrorOut, [force(true)]), 280 close(XDotOut) 281 )), 282 ( Error == "" 283 -> true 284 ; print_message(error, format('~w', [Error])) 285 ), 286 rewrite_svg_dom(SVGDom0, SVGDom), 287 format('Content-type: ~w~n~n', ['image/svg+xml; charset=UTF-8']), 288 xml_write(current_output, SVGDom, 289 [ layout(false) 290 ]). 291 292graphviz_stream(Data, PID, XDotOut, Error) :- 293 process_create(path(Data.program), ['-Tsvg'], 294 [ stdin(pipe(ToDOT)), 295 stdout(pipe(XDotOut)), 296 stderr(pipe(Error)), 297 process(PID) 298 ]), 299 set_stream(ToDOT, encoding(utf8)), 300 set_stream(XDotOut, encoding(utf8)), 301 thread_create(send_to_dot(Data.dot, ToDOT), _, 302 [ detached(true) ]). 303 304 305rewrite_svg_dom([element(svg, Attrs, Content)], 306 [element(svg, Attrs, 307 [ element(script, ['xlink:href'=SVGPan], []), 308 element(g, [ id=viewport 309 ], 310 Content) 311 ])]) :- 312 http_absolute_location(js('SVGPan.js'), SVGPan, []). 313rewrite_svg_dom(DOM, DOM). 314 315send_to_dot(Data, Out) :- 316 call_cleanup(format(Out, '~s', [Data]), 317 close(Out)), !.

323remove_old_data(Time) :- 324 ( dot_data(Hash, _, Stamp), 325 Time > Stamp+900, 326 retract(dot_data(Hash, _, Stamp)), 327 fail 328 ; true 329 ). 330 331has_graphviz_renderer(Renderer) :- 332 exe_options(ExeOptions), 333 absolute_file_name(path(Renderer), _, 334 [ file_errors(fail) 335 | ExeOptions 336 ]). 337 338exe_options(Options) :- 339 current_prolog_flag(windows, true), !, 340 Options = [ extensions(['',exe,com]), access(read) ]. 341exe_options(Options) :- 342 Options = [ access(execute) ]. 343 344no_graph_viz(Renderer) --> 345 html(div([ class('no-graph-viz'), 346 style('color:red;') 347 ], 348 [ 'The server does not have the graphviz program ', 349 code(Renderer), ' installed in PATH. ', 350 'See ', a(href('http://www.graphviz.org/'), 351 'http://www.graphviz.org/'), ' for details.' 352 ])).

357add_defaults(Statements0, Statements) :- 358 \+ memberchk(bgcolor=_, Statements0), !, 359 Statements = [bgcolor=transparent|Statements0]. 360add_defaults(Statements, Statements). 361 362 363 /******************************* 364 * GENERATING A DOT PROGRAM * 365 *******************************/ 366 367graph(graph(Statements)) --> 368 graph(graph([], Statements)). 369graph(digraph(Statements)) --> 370 graph(digraph([], Statements)). 371graph(graph(Options, Statements)) --> 372 {graph_options(Options, graph, Ctx)}, 373 graph(Statements, Ctx). 374graph(digraph(Options, Statements)) --> 375 {graph_options(Options, digraph, Ctx)}, 376 graph(Statements, Ctx). 377 378graph_options([], Type, 379 gv{type:Type, indent:2}). 380graph_options([strict], Type, 381 gv{strict:true, type:Type, indent:2}). 382graph_options([strict, ID], Type, 383 gv{strict:true, id:ID, type:Type, indent:2}). 384 385graph(Statements, Options) --> 386 { add_defaults(Statements, Statements1) }, 387 strict(Options), keyword(Options.type), ws, graph_id(Options), 388 "{", nl, 389 statements(Statements1, Options), 390 "}", nl. 391 392strict(Options) --> 393 { true == Options.get(strict) }, !, 394 keyword(strict). 395strict(_Options) --> []. 396 397graph_id(Options) --> 398 { ID = Options.get(id) }, !, 399 id(ID), ws. 400graph_id(_) --> []. 401 402statements([], _) --> []. 403statements([H|T], Options) --> 404 indent(Options), 405 ( statement(H, Options) 406 -> ";", nl 407 ; {domain_error(graphviz_statement, H)} 408 ), 409 statements(T, Options). 410 411statement(graph(Attrs), O) --> keyword(graph), ws, attributes(Attrs, O). 412statement(edge(Attrs), O) --> keyword(edge), ws, attributes(Attrs, O). 413statement(node(Attrs), O) --> keyword(node), ws, attributes(Attrs, O). 414statement(node(ID, Attrs), O) --> node(ID, O), ws, attributes(Attrs, O). 415statement(edge(Edge, Attrs), O) --> edge(Edge, O), ws, attributes(Attrs, O). 416statement(A - B, O) --> edge(A - B, O). 417statement(A -> B, O) --> edge(A -> B, O). 418statement(Name = Value, O) --> attribute(Name=Value, O). 419statement(subgraph(Statements), O) --> 420 { step_indent(O, O1) }, 421 keyword(subgraph), ws, "{", nl, 422 statements(Statements, O1), indent(O), "}". 423statement(subgraph(ID, Statements), O) --> 424 { step_indent(O, O1) }, 425 keyword(subgraph), ws, id(ID), ws, "{", nl, 426 statements(Statements, O1), indent(O), "}". 427statement(group(Statements), O) --> 428 { step_indent(O, O1) }, 429 "{", nl, statements(Statements, O1), indent(O), "}". 430statement(ID, O) --> 431 node(ID, O). 432 433step_indent(O, O2) :- 434 I is O.indent+2, 435 O2 = O.put(indent, I). 436 437edge((A-B)-C, O) --> !, edge(A-B, O), edgeop(O), id(C). 438edge(A-(B-C), O) --> !, node(A, O), edgeop(O), edge(B-C, O). 439edge(A-B, O) --> node(A, O), edgeop(O), node(B, O). 440edge((A->B)->C, O) --> !, edge(A->B, O), edgeop(O), node(C, O). 441edge(A->(B->C), O) --> !, node(A, O), edgeop(O), edge(B->C, O). 442edge(A->B, O) --> node(A, O), edgeop(O), node(B, O). 443 444edgeop(O) --> { graph == O.type }, !, " -- ". 445edgeop(_) --> " -> ". 446 447node(ID:Port:Compass, _O) --> !, 448 id(ID), ":", id(Port), ":", compass(Compass). 449node(ID:Port, _O) --> !, 450 id(ID), ":", id(Port). 451node(ID, _O) --> !, 452 id(ID). 453 454compass(Compass) --> 455 { compass(Compass) }, 456 atom(Compass). 457compass(Compass) --> 458 { domain_error(compass, Compass) }. 459 460compass('_') :- !. % handles variables 461compass(n). 462compass(ne). 463compass(e). 464compass(se). 465compass(s). 466compass(sw). 467compass(w). 468compass(nw). 469compass(c). 470 471attributes([], _) --> !. 472attributes(List, O) --> "[", attribute_list(List, O), "]". 473 474attribute_list([], _) --> []. 475attribute_list([H|T], O) --> 476 attribute(H, O), 477 ( {T == []} 478 -> [] 479 ; ",", attribute_list(T, O) 480 ). 481 482attribute(Var, _) --> 483 { var(Var), 484 instantiation_error(Var) 485 }. 486attribute(html(Value), O) --> !, 487 attribute(label=html(Value), O). 488attribute(Name=html(Value), _, List, Tail) :- 489 atomic(Value), !, 490 format(codes(List,Tail), '~w=<~w>', [Name, Value]). 491attribute(Name=html(Term), _, List, Tail) :- 492 nonvar(Term), !, 493 phrase(html(Term), Tokens0), 494 delete(Tokens0, nl(_), Tokens), 495 with_output_to(string(HTML), print_html(Tokens)), 496 format(codes(List,Tail), '~w=<~w>', [Name, HTML]). 497attribute(Name=Value, _O) --> !, 498 atom(Name),"=",value(Name, Value). 499attribute(NameValue, _O) --> 500 {NameValue =.. [Name,Value]}, !, 501 atom(Name),"=",value(Name, Value). 502attribute(NameValue, _O) --> 503 { domain_error(graphviz_attribute, NameValue) }.

509value(Name, Value) --> 510 { string_attribute(Name), !, 511 value_codes(Value, Codes) 512 }, 513 "\"", cstring(Codes), "\"". 514value(_Name, Number, List, Tail) :- 515 number(Number), !, 516 format(codes(List,Tail), '~w', [Number]). 517value(_Name, (A,B), List, Tail) :- 518 number(A), number(B), !, 519 format(codes(List,Tail), '"~w,~w"', [A, B]). 520value(_Name, Value, List, Tail) :- 521 is_graphviz_id(Value), !, 522 format(codes(List,Tail), '~w', [Value]). 523value(_Name, Value) --> 524 { value_codes(Value, Codes) 525 }, 526 "\"", cstring(Codes), "\"". 527 528id(ID) --> { number(ID) }, !, number(ID). 529id(ID) --> { atom(ID), !, atom_codes(ID, Codes) }, "\"", cstring(Codes), "\"". 530id(ID) --> { string(ID), !, string_codes(ID, Codes) }, "\"", cstring(Codes), "\"". 531id(ID) --> { format(codes(Codes), '~p', [ID]) }, "\"", cstring(Codes), "\"". 532 533keyword(Kwd) --> atom(Kwd). 534indent(Options) --> 535 { Level = Options.indent }, 536 spaces(Level). 537ws --> " ". 538nl --> "\n". 539 540spaces(0) --> !. 541spaces(N) --> 542 { succ(N2, N) }, 543 " ", 544 spaces(N2). 545 546value_codes(Value, Codes) :- 547 atomic(Value), !, 548 format(codes(Codes), '~w', [Value]). 549value_codes(Value, Codes) :- 550 format(codes(Codes), '~p', [Value]).

557is_graphviz_id(Atom) :- 558 ( atom(Atom) 559 -> true 560 ; string(Atom) 561 ), 562 atom_codes(Atom, Codes), 563 maplist(id_code, Codes), 564 Codes = [C0|_], 565 \+ between(0'0, 0'9, C0). 566 567id_code(C) :- between(0'a, 0'z, C). 568id_code(C) :- between(0'A, 0'Z, C). 569id_code(C) :- between(0'0, 0'9, C). 570id_code(C) :- between(0'_, 0'_, C). 571id_code(C) :- between(8'200, 8'377, C). 572 573 574 /******************************* 575 * DOT PRIMITIVES * 576 *******************************/ 577 578/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 579This code is copied from ClioPatria, rdf_graphviz.pl 580- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 581 582string_attribute(label). 583string_attribute(xlabel). 584string_attribute(tooltip). 585string_attribute(headtooltip). 586string_attribute(tailtooltip). 587string_attribute(labeltooltip). 588string_attribute(url). 589string_attribute(href). 590string_attribute(id). 591string_attribute('URL'). 592string_attribute(fillcolor). 593string_attribute(fontcolor). 594string_attribute(color). 595string_attribute(fontname). 596string_attribute(style). 597string_attribute(size).

606gv_attr(align, table, oneof([center,left,right])). 607gv_attr(bgcolor, table, atom). 608gv_attr(border, table, atom). 609gv_attr(cellborder, table, atom). 610gv_attr(cellpadding, table, atom). 611gv_attr(cellspacing, table, atom). 612gv_attr(color, table, atom). 613gv_attr(fixedsize, table, boolean). 614gv_attr(height, table, atom). 615gv_attr(href, table, atom). 616gv_attr(port, table, atom). 617gv_attr(target, table, atom). 618gv_attr(title, table, atom). 619gv_attr(tooltip, table, atom). 620gv_attr(valign, table, oneof([middle,bottom,top])). 621gv_attr(width, table, atom). 622 623gv_attr(align, td, oneof([center,left,right,text])). 624gv_attr(balign, td, oneof([center,left,right])). 625gv_attr(bgcolor, td, atom). 626gv_attr(border, td, atom). 627gv_attr(cellpadding, td, atom). 628gv_attr(cellspacing, td, atom). 629gv_attr(color, td, atom). 630gv_attr(colspan, td, integer). 631gv_attr(fixedsize, td, boolean). 632gv_attr(height, td, atom). 633gv_attr(href, td, atom). 634gv_attr(port, td, atom). 635gv_attr(rowspan, td, integer). 636gv_attr(target, td, atom). 637gv_attr(title, td, atom). 638gv_attr(tooltip, td, atom). 639gv_attr(valign, td, oneof([middle,bottom,top])). 640gv_attr(width, td, atom). 641 642gv_attr(color, font, atom). 643gv_attr(face, font, atom). 644gv_attr('point-size', font, integer). 645 646gv_attr(align, br, oneof([center,left,right])). 647 648gv_attr(scale, img, oneof([false,true,width,height,both])). 649gv_attr(src, img, atom).

656cstring([]) --> 657 []. 658cstring([H|T]) --> 659 ( cchar(H) 660 -> [] 661 ; [H] 662 ), 663 cstring(T). 664 665cchar(0'") --> "\\\"". 666cchar(0'\n) --> "\\n". 667cchar(0'\t) --> "\\t". 668cchar(0'\b) --> "\\b"