1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2014-2018, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(pengines_io, 37 [ pengine_writeln/1, % +Term 38 pengine_nl/0, 39 pengine_flush_output/0, 40 pengine_format/1, % +Format 41 pengine_format/2, % +Format, +Args 42 43 pengine_write_term/2, % +Term, +Options 44 pengine_write/1, % +Term 45 pengine_writeq/1, % +Term 46 pengine_display/1, % +Term 47 pengine_print/1, % +Term 48 pengine_write_canonical/1, % +Term 49 50 pengine_listing/0, 51 pengine_listing/1, % +Spec 52 pengine_portray_clause/1, % +Term 53 54 pengine_read/1, % -Term 55 pengine_read_line_to_string/2, % +Stream, -LineAsString 56 pengine_read_line_to_codes/2, % +Stream, -LineAsCodes 57 58 pengine_io_predicate/1, % ?Head 59 pengine_bind_io_to_html/1, % +Module 60 pengine_io_goal_expansion/2,% +Goal, -Expanded 61 62 message_lines_to_html/3 % +Lines, +Classes, -HTML 63 ]). 64:- use_module(library(lists)). 65:- use_module(library(pengines)). 66:- use_module(library(option)). 67:- use_module(library(debug)). 68:- use_module(library(error)). 69:- use_module(library(apply)). 70:- use_module(library(settings)). 71:- use_module(library(listing)). 72:- use_module(library(yall)). 73:- use_module(library(sandbox), []). 74:- use_module(library(http/html_write)). 75:- use_module(library(http/term_html)). 76:- if(exists_source(library(prolog_stream))). 77:- use_module(library(prolog_stream)). 78:- endif. 79:- html_meta send_html(). 80 81:- meta_predicate 82 pengine_format(,).
117:- setting(write_options, list(any), [max_depth(1000)], 118 'Additional options for stringifying Prolog results'). 119 120 121 /******************************* 122 * OUTPUT * 123 *******************************/
129pengine_writeln(Term) :- 130 pengine_output, 131 !, 132 pengine_module(Module), 133 send_html(span(class(writeln), 134 [ \term(Term, 135 [ module(Module) 136 ]), 137 br([]) 138 ])). 139pengine_writeln(Term) :- 140 writeln(Term).
146pengine_nl :- 147 pengine_output, 148 !, 149 send_html(br([])). 150pengine_nl :- 151 nl.
158pengine_flush_output :- 159 pengine_output, 160 !. 161pengine_flush_output :- 162 flush_output.
write.172pengine_write_term(Term, Options) :- 173 pengine_output, 174 !, 175 option(class(Class), Options, write), 176 pengine_module(Module), 177 send_html(span(class(Class), \term(Term,[module(Module)|Options]))). 178pengine_write_term(Term, Options) :- 179 write_term(Term, Options).
189pengine_write(Term) :- 190 pengine_write_term(Term, [numbervars(true)]). 191pengine_writeq(Term) :- 192 pengine_write_term(Term, [quoted(true), numbervars(true)]). 193pengine_display(Term) :- 194 pengine_write_term(Term, [quoted(true), ignore_ops(true)]). 195pengine_print(Term) :- 196 current_prolog_flag(print_write_options, Options), 197 pengine_write_term(Term, Options). 198pengine_write_canonical(Term) :- 199 pengine_output, 200 !, 201 with_output_to(string(String), write_canonical(Term)), 202 send_html(span(class([write, cononical]), String)). 203pengine_write_canonical(Term) :- 204 write_canonical(Term).
214pengine_format(Format) :- 215 pengine_format(Format, []). 216pengine_format(Format, Args) :- 217 pengine_output, 218 !, 219 format(string(String), Format, Args), 220 split_string(String, "\n", "", Lines), 221 send_html(\lines(Lines, format)). 222pengine_format(Format, Args) :- 223 format(Format, Args). 224 225 226 /******************************* 227 * LISTING * 228 *******************************/
236pengine_listing :- 237 pengine_listing(_). 238 239pengine_listing(Spec) :- 240 pengine_self(Module), 241 with_output_to(string(String), listing(Module:Spec)), 242 split_string(String, "", "\n", [Pre]), 243 send_html(pre(class(listing), Pre)). 244 245pengine_portray_clause(Term) :- 246 pengine_output, 247 !, 248 with_output_to(string(String), portray_clause(Term)), 249 split_string(String, "", "\n", [Pre]), 250 send_html(pre(class(listing), Pre)). 251pengine_portray_clause(Term) :- 252 portray_clause(Term). 253 254 255 /******************************* 256 * PRINT MESSAGE * 257 *******************************/ 258 259:- multifile user:message_hook/3.
266user:message_hook(Term, Kind, Lines) :-
267 Kind \== silent,
268 pengine_self(_),
269 atom_concat('msg-', Kind, Class),
270 message_lines_to_html(Lines, [Class], HTMlString),
271 ( source_location(File, Line)
272 -> Src = File:Line
273 ; Src = (-)
274 ),
275 pengine_output(message(Term, Kind, HTMlString, Src)).'prolog-message' and the given Classes.283message_lines_to_html(Lines, Classes, HTMlString) :- 284 phrase(html(pre(class(['prolog-message'|Classes]), 285 \message_lines(Lines))), Tokens), 286 with_output_to(string(HTMlString), print_html(Tokens)). 287 288message_lines([]) --> 289 !. 290message_lines([nl|T]) --> 291 !, 292 html('\n'), % we are in a <pre> environment 293 message_lines(T). 294message_lines([flush]) --> 295 !. 296message_lines([ansi(Attributes, Fmt, Args)|T]) --> 297 !, 298 { is_list(Attributes) 299 -> foldl(style, Attributes, Fmt-Args, HTML) 300 ; style(Attributes, Fmt-Args, HTML) 301 }, 302 html(HTML), 303 message_lines(T). 304message_lines([H|T]) --> 305 html(H), 306 message_lines(T). 307 308style(bold, Content, b(Content)) :- !. 309style(fg(default), Content, span(style('color: black'), Content)) :- !. 310style(fg(Color), Content, span(style('color:'+Color), Content)) :- !. 311style(_, Content, Content). 312 313 314 /******************************* 315 * INPUT * 316 *******************************/ 317 318pengine_read(Term) :- 319 pengine_input, 320 !, 321 prompt(Prompt, Prompt), 322 pengine_input(Prompt, Term). 323pengine_read(Term) :- 324 read(Term). 325 326pengine_read_line_to_string(From, String) :- 327 pengine_input, 328 !, 329 must_be(oneof([current_input,user_input]), From), 330 ( prompt(Prompt, Prompt), 331 Prompt \== '' 332 -> true 333 ; Prompt = 'line> ' 334 ), 335 pengine_input(_{type: console, prompt:Prompt}, StringNL), 336 string_concat(String, "\n", StringNL). 337pengine_read_line_to_string(From, String) :- 338 read_line_to_string(From, String). 339 340pengine_read_line_to_codes(From, Codes) :- 341 pengine_read_line_to_string(From, String), 342 string_codes(String, Codes). 343 344 345 /******************************* 346 * HTML * 347 *******************************/ 348 349lines([], _) --> []. 350lines([H|T], Class) --> 351 html(span(class(Class), H)), 352 ( { T == [] } 353 -> [] 354 ; html(br([])), 355 lines(T, Class) 356 ).
363send_html(HTML) :-
364 phrase(html(HTML), Tokens),
365 with_output_to(string(HTMlString), print_html(Tokens)),
366 pengine_output(HTMlString).373pengine_module(Module) :- 374 pengine_self(Pengine), 375 !, 376 pengine_property(Pengine, module(Module)). 377pengine_module(user). 378 379 /******************************* 380 * OUTPUT FORMAT * 381 *******************************/
410:- multifile
411 pengines:event_to_json/3.'json-s' or 'json-html', emit a simplified
JSON representation of the data, suitable for notably SWISH.
This deals with Prolog answers and output messages. If a message
originates from print_message/3, it gets several additional
properties:
error, warning,
etc.)428penginesevent_to_json(success(ID, Answers0, Projection, Time, More), JSON, 429 'json-s') :- 430 !, 431 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More}, 432 maplist(answer_to_json_strings(ID), Answers0, Answers), 433 add_projection(Projection, JSON0, JSON). 434penginesevent_to_json(output(ID, Term), JSON, 'json-s') :- 435 !, 436 map_output(ID, Term, JSON). 437 438add_projection([], JSON, JSON) :- !. 439add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
447answer_to_json_strings(Pengine, DictIn, DictOut) :- 448 dict_pairs(DictIn, Tag, Pairs), 449 maplist(term_string_value(Pengine), Pairs, BindingsOut), 450 dict_pairs(DictOut, Tag, BindingsOut). 451 452term_string_value(Pengine, N-V, N-A) :- 453 with_output_to(string(A), 454 write_term(V, 455 [ module(Pengine), 456 quoted(true) 457 ])).
json-html format. This
format represents the answer as JSON, but the variable bindings are
(structured) HTML strings rather than JSON objects.
CHR residual goals are not bound to the projection variables. We hacked a bypass to fetch these by returning them in a variable named _residuals, which must be bound to a term '$residuals'(List). Such a variable is removed from the projection and added to residual goals.
471penginesevent_to_json(success(ID, Answers0, Projection, Time, More), 472 JSON, 'json-html') :- 473 !, 474 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More}, 475 maplist(map_answer(ID), Answers0, ResVars, Answers), 476 add_projection(Projection, ResVars, JSON0, JSON). 477penginesevent_to_json(output(ID, Term), JSON, 'json-html') :- 478 !, 479 map_output(ID, Term, JSON). 480 481map_answer(ID, Bindings0, ResVars, Answer) :- 482 dict_bindings(Bindings0, Bindings1), 483 select_residuals(Bindings1, Bindings2, ResVars, Residuals0), 484 append(Residuals0, Residuals1), 485 prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1, 486 ID:Residuals-_HiddenResiduals), 487 maplist(binding_to_html(ID), Bindings3, VarBindings), 488 ( Residuals == [] 489 -> Answer = json{variables:VarBindings} 490 ; residuals_html(Residuals, ID, ResHTML), 491 Answer = json{variables:VarBindings, residuals:ResHTML} 492 ). 493 494residuals_html([], _, []). 495residuals_html([H0|T0], Module, [H|T]) :- 496 term_html_string(H0, [], Module, H, [priority(999)]), 497 residuals_html(T0, Module, T). 498 499dict_bindings(Dict, Bindings) :- 500 dict_pairs(Dict, _Tag, Pairs), 501 maplist([N-V,N=V]>>true, Pairs, Bindings). 502 503select_residuals([], [], [], []). 504select_residuals([H|T], Bindings, Vars, Residuals) :- 505 binding_residual(H, Var, Residual), 506 !, 507 Vars = [Var|TV], 508 Residuals = [Residual|TR], 509 select_residuals(T, Bindings, TV, TR). 510select_residuals([H|T0], [H|T], Vars, Residuals) :- 511 select_residuals(T0, T, Vars, Residuals). 512 513binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :- 514 is_list(Residuals). 515binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :- 516 is_list(Residuals). 517binding_residual('Residual' = '$residual'(Residual), 'Residual', [Residual]) :- 518 callable(Residual). 519 520add_projection(-, _, JSON, JSON) :- !. 521add_projection(VarNames0, ResVars0, JSON0, JSON) :- 522 append(ResVars0, ResVars1), 523 sort(ResVars1, ResVars), 524 subtract(VarNames0, ResVars, VarNames), 525 add_projection(VarNames, JSON0, JSON).
536binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
537 JSON0 = json{variables:Vars, value:HTMLString},
538 term_html_string(Term, Vars, ID, HTMLString, [priority(699)]),
539 ( Substitutions == []
540 -> JSON = JSON0
541 ; maplist(subst_to_html(ID), Substitutions, HTMLSubst),
542 JSON = JSON0.put(substitutions, HTMLSubst)
543 ).
552term_html_string(Term, Vars, Module, HTMLString, Options) :-
553 setting(write_options, WOptions),
554 merge_options(WOptions,
555 [ quoted(true),
556 numbervars(true),
557 module(Module)
558 | Options
559 ], WriteOptions),
560 phrase(term_html(Term, Vars, WriteOptions), Tokens),
561 with_output_to(string(HTMLString), print_html(Tokens)).573:- multifile binding_term//3. 574 575term_html(Term, Vars, WriteOptions) --> 576 { nonvar(Term) }, 577 binding_term(Term, Vars, WriteOptions), 578 !. 579term_html(Term, _Vars, WriteOptions) --> 580 term(Term, WriteOptions).
587subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :- 588 !, 589 term_html_string(Value, [Name], ID, HTMLString, [priority(699)]). 590subst_to_html(_, Term, _) :- 591 assertion(Term = '$VAR'(_)).
598map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :- 599 atomic(HTMLString), 600 !, 601 JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString}, 602 pengines:add_error_details(Term, JSON0, JSON1), 603 ( Src = File:Line, 604 \+ JSON1.get(location) = _ 605 -> JSON = JSON1.put(_{location:_{file:File, line:Line}}) 606 ; JSON = JSON1 607 ). 608map_output(ID, Term, json{event:output, id:ID, data:Data}) :- 609 ( atomic(Term) 610 -> Data = Term 611 ; is_dict(Term, json), 612 ground(json) % TBD: Check proper JSON object? 613 -> Data = Term 614 ; term_string(Term, Data) 615 ).
622:- multifile 623 prolog_help:show_html_hook/1. 624 625prolog_helpshow_html_hook(HTML) :- 626 pengine_output, 627 pengine_output(HTML). 628 629 630 /******************************* 631 * SANDBOXING * 632 *******************************/ 633 634:- multifile 635 sandbox:safe_primitive/1, % Goal 636 sandbox:safe_meta/2. % Goal, Called 637 638sandbox:safe_primitive(pengines_io:pengine_listing(_)). 639sandbox:safe_primitive(pengines_io:pengine_nl). 640sandbox:safe_primitive(pengines_io:pengine_flush_output). 641sandbox:safe_primitive(pengines_io:pengine_print(_)). 642sandbox:safe_primitive(pengines_io:pengine_write(_)). 643sandbox:safe_primitive(pengines_io:pengine_read(_)). 644sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)). 645sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)). 646sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)). 647sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)). 648sandbox:safe_primitive(pengines_io:pengine_writeln(_)). 649sandbox:safe_primitive(pengines_io:pengine_writeq(_)). 650sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)). 651sandbox:safe_primitive(system:write_term(_,_)). 652sandbox:safe_primitive(system:prompt(_,_)). 653sandbox:safe_primitive(system:statistics(_,_)). 654 655sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :- 656 sandbox:format_calls(Format, Args, Calls). 657 658 659 /******************************* 660 * REDEFINITION * 661 *******************************/
668pengine_io_predicate(writeln(_)). 669pengine_io_predicate(nl). 670pengine_io_predicate(flush_output). 671pengine_io_predicate(format(_)). 672pengine_io_predicate(format(_,_)). 673pengine_io_predicate(read(_)). 674pengine_io_predicate(read_line_to_string(_,_)). 675pengine_io_predicate(read_line_to_codes(_,_)). 676pengine_io_predicate(write_term(_,_)). 677pengine_io_predicate(write(_)). 678pengine_io_predicate(writeq(_)). 679pengine_io_predicate(display(_)). 680pengine_io_predicate(print(_)). 681pengine_io_predicate(write_canonical(_)). 682pengine_io_predicate(listing). 683pengine_io_predicate(listing(_)). 684pengine_io_predicate(portray_clause(_)). 685 686term_expansion(pengine_io_goal_expansion(_,_), 687 Clauses) :- 688 findall(Clause, io_mapping(Clause), Clauses). 689 690io_mapping(pengine_io_goal_expansion(Head, Mapped)) :- 691 pengine_io_predicate(Head), 692 Head =.. [Name|Args], 693 atom_concat(pengine_, Name, BodyName), 694 Mapped =.. [BodyName|Args]. 695 696pengine_io_goal_expansion(_, _). 697 698 699 /******************************* 700 * REBIND PENGINE I/O * 701 *******************************/ 702 703:- public 704 stream_write/2, 705 stream_read/2, 706 stream_close/1. 707 708:- thread_local 709 pengine_io/2. 710 711stream_write(_Stream, Out) :- 712 send_html(pre(class(console), Out)). 713stream_read(_Stream, Data) :- 714 prompt(Prompt, Prompt), 715 pengine_input(_{type:console, prompt:Prompt}, Data). 716stream_close(_Stream).
726pengine_bind_user_streams :- 727 Err = Out, 728 open_prolog_stream(pengines_io, write, Out, []), 729 set_stream(Out, buffer(line)), 730 open_prolog_stream(pengines_io, read, In, []), 731 set_stream(In, alias(user_input)), 732 set_stream(Out, alias(user_output)), 733 set_stream(Err, alias(user_error)), 734 set_stream(In, alias(current_input)), 735 set_stream(Out, alias(current_output)), 736 assertz(pengine_io(In, Out)), 737 thread_at_exit(close_io). 738 739close_io :- 740 retract(pengine_io(In, Out)), 741 !, 742 close(In, [force(true)]), 743 close(Out, [force(true)]). 744close_io.
751pengine_output :- 752 current_output(Out), 753 pengine_io(_, Out). 754 755pengine_input :- 756 current_input(In), 757 pengine_io(In, _).
765pengine_bind_io_to_html(Module) :- 766 forall(pengine_io_predicate(Head), 767 bind_io(Head, Module)), 768 pengine_bind_user_streams. 769 770bind_io(Head, Module) :- 771 prompt(_, ''), 772 redefine_system_predicate(Module:Head), 773 functor(Head, Name, Arity), 774 Head =.. [Name|Args], 775 atom_concat(pengine_, Name, BodyName), 776 Body =.. [BodyName|Args], 777 assertz(Module:(Head :- Body)), 778 compile_predicates([Module:Name/Arity])
Provide Prolog I/O for HTML clients
This module redefines some of the standard Prolog I/O predicates to behave transparently for HTML clients. It provides two ways to redefine the standard predicates: using goal_expansion/2 and by redefining the system predicates using redefine_system_predicate/1. The latter is the preferred route because it gives a more predictable trace to the user and works regardless of the use of other expansion and meta-calling.
Redefining works by redefining the system predicates in the context of the pengine's module. This is configured using the following code snippet.
:- pengine_application(myapp). :- use_module(myapp:library(pengines_io)). pengines:prepare_module(Module, myapp, _Options) :- pengines_io:pengine_bind_io_to_html(Module).Using goal_expansion/2 works by rewriting the corresponding goals using goal_expansion/2 and use the new definition to re-route I/O via pengine_input/2 and pengine_output/1. A pengine application is prepared for using this module with the following code:
:- pengine_application(myapp). :- use_module(myapp:library(pengines_io)). myapp:goal_expansion(In,Out) :- pengine_io_goal_expansion(In, Out).*/