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

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

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

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

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

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

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

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

664cstring([]) --> 665 []. 666cstring([H|T]) --> 667 ( cchar(H) 668 -> [] 669 ; [H] 670 ), 671 cstring(T). 672 673cchar(0'") --> "\\\"". 674cchar(0'\n) --> "\\n". 675cchar(0'\t) --> "\\t". 676cchar(0'\b) --> "\\b"