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 render_dot//3, % DOTString, Program, Options) 38 svg//2 % +String, +Options 39 ]). 40:- use_module(library(http/html_write)). 41:- use_module(library(http/js_write)). 42:- use_module(library(http/http_dispatch)). 43:- use_module(library(http/http_parameters)). 44:- use_module(library(http/http_path)). 45:- use_module(library(process)). 46:- use_module(library(sgml)). 47:- use_module(library(debug)). 48:- use_module(library(error)). 49:- use_module(library(option)). 50:- use_module(library(lists)). 51:- use_module(library(apply)). 52:- use_module(library(dcg/basics)). 53:- use_module('../render'). 54 55:- 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)

108term_rendering(Data, Vars, Options) --> 109 { debug(graphviz(vars), 'Data: ~q, vars: ~p', [Data, Vars]), 110 data_to_graphviz_string(Data, DOTString, Program), 111 ( debugging(graphviz(save_dot(File))) 112 -> setup_call_cleanup( 113 open(File, write, Out, [encoding(utf8)]), 114 write(Out, DOTString), 115 close(Out)) 116 ; true 117 ) 118 }, 119 render_dot(DOTString, Program, Options).

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

184svg(SVG0, _Options) --> 185 { fix_svg(SVG0, SVG) }, 186 html([ \[SVG], 187 \js_script({|javascript|| 188(function() { 189 if ( $.ajaxScript ) { 190 var div = $.ajaxScript.parent(); 191 var svg = div.find("svg"); 192 var data = { w0: svg.width(), 193 h0: svg.height() 194 }; 195 var pan; 196 197 function updateSize() { 198 var w = svg.closest("div.answer").innerWidth(); 199 200 function reactive() { 201 if ( !data.reactive ) { 202 data.reactive = true; 203 div.on("reactive-resize", updateSize); 204 } 205 } 206 207 w = Math.max(w*0.85, 100); 208 if ( w < data.w0 ) { 209 svg.width(w); 210 svg.height(w = Math.max(w*data.h0/data.w0, w/4)); 211 reactive(); 212 if ( pan ) { 213 pan.resize(); 214 pan.fit(); 215 pan.center(); 216 } 217 } 218 } 219 220 require(["svg-pan-zoom"], function(svgPanZoom) { 221 updateSize() 222 pan = svgPanZoom(svg[0], { 223 // controlIconsEnabled: true 224 minZoom: 0.1, 225 maxZoom: 50 226 }); 227 }); 228 } 229 })(); 230 |}) 231 ]). 232 233 234fix_svg(InS, OutS) :- 235 setup_call_cleanup( 236 open_string(InS, In), 237 load_xml(In, M, 238 [ max_errors(-1), 239 syntax_errors(quiet) 240 ]), 241 close(In)), 242 with_output_to( 243 string(OutS), 244 xml_write(current_output, M, 245 [ layout(false), 246 doctype('svg'), 247 public('-//W3C//DTD SVG 1.1//EN'), 248 system('http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd') 249 ])).

256data_to_graphviz_string(Compound, String, Program) :- 257 compound(Compound), 258 compound_name_arguments(Compound, Program, [Data]), 259 graphviz_program(Program), 260 ( atomic(Data) 261 -> String = Data 262 ; phrase(graph(Data), Codes), 263 string_codes(String, Codes), 264 debug(graphviz, '~s', [String]) 265 ). 266data_to_graphviz_string(Compound, String, dot) :- 267 compound(Compound), 268 compound_name_arity(Compound, Type, Arity), 269 graph_type(Type), 270 between(1,2,Arity), !, 271 phrase(graph(Compound), Codes), 272 string_codes(String, Codes), 273 debug(graphviz, '~s', [String]). 274 275 276graphviz_program(dot). 277graphviz_program(neato). 278graphviz_program(fdp). 279graphviz_program(sfdp). 280graphviz_program(twopi). 281graphviz_program(circo). 282graphviz_program(osage). 283graphviz_program(patchwork). 284 285graph_type(graph). 286graph_type(digraph).

292swish_send_graphviz(Request) :- 293 http_parameters(Request, 294 [ hash(Hash, 295 [ description('Hash-key to the graph-data') 296 ]) 297 ]), 298 dot_data(Hash, Data, _), 299 graphviz_stream(Data, PID, XDotOut, ErrorOut), 300 call_cleanup(( load_structure(stream(XDotOut), 301 SVGDom0, 302 [ dialect(xml) ]), 303 read_string(ErrorOut, _, Error) 304 ), 305 ( process_wait_0(PID), 306 close(ErrorOut, [force(true)]), 307 close(XDotOut) 308 )), 309 ( Error == "" 310 -> true 311 ; print_message(error, format('~w', [Error])) 312 ), 313 rewrite_svg_dom(SVGDom0, SVGDom), 314 format('Content-type: ~w~n~n', ['image/svg+xml; charset=UTF-8']), 315 xml_write(current_output, SVGDom, 316 [ layout(false) 317 ]). 318 319graphviz_stream(Data, PID, XDotOut, Error) :- 320 process_create(path(Data.program), ['-Tsvg'], 321 [ stdin(pipe(ToDOT)), 322 stdout(pipe(XDotOut)), 323 stderr(pipe(Error)), 324 process(PID) 325 ]), 326 set_stream(ToDOT, encoding(utf8)), 327 set_stream(XDotOut, encoding(utf8)), 328 thread_create(send_to_dot(Data.dot, ToDOT), _, 329 [ detached(true) ]). 330 331 332rewrite_svg_dom([element(svg, Attrs, Content)], 333 [element(svg, Attrs, 334 [ element(script, ['xlink:href'=SVGPan], []), 335 element(g, [ id=viewport 336 ], 337 Content) 338 ])]) :- 339 http_absolute_location(js('SVGPan.js'), SVGPan, []). 340rewrite_svg_dom(DOM, DOM). 341 342send_to_dot(Data, Out) :- 343 call_cleanup(format(Out, '~s', [Data]), 344 close(Out)), !.

350remove_old_data(Time) :- 351 ( dot_data(Hash, _, Stamp), 352 Time > Stamp+900, 353 retract(dot_data(Hash, _, Stamp)), 354 fail 355 ; true 356 ). 357 358has_graphviz_renderer(Renderer) :- 359 exe_options(ExeOptions), 360 absolute_file_name(path(Renderer), _, 361 [ file_errors(fail) 362 | ExeOptions 363 ]). 364 365exe_options(Options) :- 366 current_prolog_flag(windows, true), !, 367 Options = [ extensions(['',exe,com]), access(read) ]. 368exe_options(Options) :- 369 Options = [ access(execute) ]. 370 371no_graph_viz(Renderer) --> 372 html(div([ class('no-graph-viz'), 373 style('color:red;') 374 ], 375 [ 'The server does not have the graphviz program ', 376 code(Renderer), ' installed in PATH. ', 377 'See ', a(href('http://www.graphviz.org/'), 378 'http://www.graphviz.org/'), ' for details.' 379 ])).

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

536value(Name, Value) --> 537 { string_attribute(Name), !, 538 value_codes(Value, Codes) 539 }, 540 "\"", cstring(Codes), "\"". 541value(_Name, Number, List, Tail) :- 542 number(Number), !, 543 format(codes(List,Tail), '~w', [Number]). 544value(_Name, (A,B), List, Tail) :- 545 number(A), number(B), !, 546 format(codes(List,Tail), '"~w,~w"', [A, B]). 547value(_Name, Value, List, Tail) :- 548 is_graphviz_id(Value), !, 549 format(codes(List,Tail), '~w', [Value]). 550value(_Name, Value) --> 551 { value_codes(Value, Codes) 552 }, 553 "\"", cstring(Codes), "\"". 554 555id(ID) --> { number(ID) }, !, number(ID). 556id(ID) --> { atom(ID), !, atom_codes(ID, Codes) }, "\"", cstring(Codes), "\"". 557id(ID) --> { string(ID), !, string_codes(ID, Codes) }, "\"", cstring(Codes), "\"". 558id(ID) --> { format(codes(Codes), '~p', [ID]) }, "\"", cstring(Codes), "\"". 559 560keyword(Kwd) --> atom(Kwd). 561indent(Options) --> 562 { Level = Options.indent }, 563 spaces(Level). 564ws --> " ". 565nl --> "\n". 566 567spaces(0) --> !. 568spaces(N) --> 569 { succ(N2, N) }, 570 " ", 571 spaces(N2). 572 573value_codes(Value, Codes) :- 574 atomic(Value), !, 575 format(codes(Codes), '~w', [Value]). 576value_codes(Value, Codes) :- 577 format(codes(Codes), '~p', [Value]).

584is_graphviz_id(Atom) :- 585 ( atom(Atom) 586 -> true 587 ; string(Atom) 588 ), 589 atom_codes(Atom, Codes), 590 maplist(id_code, Codes), 591 Codes = [C0|_], 592 \+ between(0'0, 0'9, C0). 593 594id_code(C) :- between(0'a, 0'z, C). 595id_code(C) :- between(0'A, 0'Z, C). 596id_code(C) :- between(0'0, 0'9, C). 597id_code(C) :- between(0'_, 0'_, C). 598id_code(C) :- between(8'200, 8'377, C). 599 600 601 /******************************* 602 * DOT PRIMITIVES * 603 *******************************/ 604 605/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 606This code is copied from ClioPatria, rdf_graphviz.pl 607- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 608 609string_attribute(label). 610string_attribute(xlabel). 611string_attribute(tooltip). 612string_attribute(headtooltip). 613string_attribute(tailtooltip). 614string_attribute(labeltooltip). 615string_attribute(url). 616string_attribute(href). 617string_attribute(id). 618string_attribute('URL'). 619string_attribute(fillcolor). 620string_attribute(fontcolor). 621string_attribute(color). 622string_attribute(fontname). 623string_attribute(style). 624string_attribute(size).

633gv_attr(align, table, oneof([center,left,right])). 634gv_attr(bgcolor, table, atom). 635gv_attr(border, table, atom). 636gv_attr(cellborder, table, atom). 637gv_attr(cellpadding, table, atom). 638gv_attr(cellspacing, table, atom). 639gv_attr(color, table, atom). 640gv_attr(fixedsize, table, boolean). 641gv_attr(height, table, atom). 642gv_attr(href, table, atom). 643gv_attr(port, table, atom). 644gv_attr(target, table, atom). 645gv_attr(title, table, atom). 646gv_attr(tooltip, table, atom). 647gv_attr(valign, table, oneof([middle,bottom,top])). 648gv_attr(width, table, atom). 649 650gv_attr(align, td, oneof([center,left,right,text])). 651gv_attr(balign, td, oneof([center,left,right])). 652gv_attr(bgcolor, td, atom). 653gv_attr(border, td, atom). 654gv_attr(cellpadding, td, atom). 655gv_attr(cellspacing, td, atom). 656gv_attr(color, td, atom). 657gv_attr(colspan, td, integer). 658gv_attr(fixedsize, td, boolean). 659gv_attr(height, td, atom). 660gv_attr(href, td, atom). 661gv_attr(port, td, atom). 662gv_attr(rowspan, td, integer). 663gv_attr(target, td, atom). 664gv_attr(title, td, atom). 665gv_attr(tooltip, td, atom). 666gv_attr(valign, td, oneof([middle,bottom,top])). 667gv_attr(width, td, atom). 668 669gv_attr(color, font, atom). 670gv_attr(face, font, atom). 671gv_attr('point-size', font, integer). 672 673gv_attr(align, br, oneof([center,left,right])). 674 675gv_attr(scale, img, oneof([false,true,width,height,both])). 676gv_attr(src, img, atom).

683cstring([]) --> 684 []. 685cstring([H|T]) --> 686 ( cchar(H) 687 -> [] 688 ; [H] 689 ), 690 cstring(T). 691 692cchar(0'") --> "\\\"". 693cchar(0'\n) --> "\\n". 694cchar(0'\t) --> "\\t". 695cchar(0'\b) --> "\\b"