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-2017, 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(pengines_io, 36 [ pengine_writeln/1, % +Term 37 pengine_nl/0, 38 pengine_flush_output/0, 39 pengine_format/1, % +Format 40 pengine_format/2, % +Format, +Args 41 42 pengine_write_term/2, % +Term, +Options 43 pengine_write/1, % +Term 44 pengine_writeq/1, % +Term 45 pengine_display/1, % +Term 46 pengine_print/1, % +Term 47 pengine_write_canonical/1, % +Term 48 49 pengine_listing/0, 50 pengine_listing/1, % +Spec 51 pengine_portray_clause/1, % +Term 52 53 pengine_read/1, % -Term 54 pengine_read_line_to_string/2, % +Stream, -LineAsString 55 pengine_read_line_to_codes/2, % +Stream, -LineAsCodes 56 57 pengine_io_predicate/1, % ?Head 58 pengine_bind_io_to_html/1, % +Module 59 pengine_io_goal_expansion/2 % +Goal, -Expanded 60 ]). 61:- use_module(library(lists)). 62:- use_module(library(pengines)). 63:- use_module(library(option)). 64:- use_module(library(debug)). 65:- use_module(library(error)). 66:- use_module(library(apply)). 67:- use_module(library(settings)). 68:- use_module(library(listing)). 69:- use_module(library(yall)). 70:- use_module(library(sandbox), []). 71:- use_module(library(http/html_write)). 72:- use_module(library(http/term_html)). 73:- if(exists_source(library(prolog_stream))). 74:- use_module(library(prolog_stream)). 75:- endif. 76:- html_meta send_html( ). 77 78:- meta_predicate 79 pengine_format( , ).
114:- setting(write_options, list(any), [max_depth(1000)], 115 'Additional options for stringifying Prolog results'). 116 117 118 /******************************* 119 * OUTPUT * 120 *******************************/
126pengine_writeln(Term) :- 127 pengine_output, 128 !, 129 pengine_module(Module), 130 send_html(span(class(writeln), 131 [ \term(Term, 132 [ module(Module) 133 ]), 134 br([]) 135 ])). 136pengine_writeln(Term) :- 137 writeln(Term).
143pengine_nl :- 144 pengine_output, 145 !, 146 send_html(br([])). 147pengine_nl :- 148 nl.
155pengine_flush_output :- 156 pengine_output, 157 !. 158pengine_flush_output :- 159 flush_output.
write
.169pengine_write_term(Term, Options) :- 170 pengine_output, 171 !, 172 option(class(Class), Options, write), 173 pengine_module(Module), 174 send_html(span(class(Class), \term(Term,[module(Module)|Options]))). 175pengine_write_term(Term, Options) :- 176 write_term(Term, Options).
186pengine_write(Term) :- 187 pengine_write_term(Term, []). 188pengine_writeq(Term) :- 189 pengine_write_term(Term, [quoted(true), numbervars(true)]). 190pengine_display(Term) :- 191 pengine_write_term(Term, [quoted(true), ignore_ops(true)]). 192pengine_print(Term) :- 193 current_prolog_flag(print_write_options, Options), 194 pengine_write_term(Term, Options). 195pengine_write_canonical(Term) :- 196 pengine_output, 197 !, 198 with_output_to(string(String), write_canonical(Term)), 199 send_html(span(class([write, cononical]), String)). 200pengine_write_canonical(Term) :- 201 write_canonical(Term).
211pengine_format(Format) :- 212 pengine_format(Format, []). 213pengine_format(Format, Args) :- 214 pengine_output, 215 !, 216 format(string(String), Format, Args), 217 split_string(String, "\n", "", Lines), 218 send_html(\lines(Lines, format)). 219pengine_format(Format, Args) :- 220 format(Format, Args). 221 222 223 /******************************* 224 * LISTING * 225 *******************************/
233pengine_listing :- 234 pengine_listing(_). 235 236pengine_listing(Spec) :- 237 pengine_self(Module), 238 with_output_to(string(String), listing(Module:Spec)), 239 split_string(String, "", "\n", [Pre]), 240 send_html(pre(class(listing), Pre)). 241 242pengine_portray_clause(Term) :- 243 pengine_output, 244 !, 245 with_output_to(string(String), portray_clause(Term)), 246 split_string(String, "", "\n", [Pre]), 247 send_html(pre(class(listing), Pre)). 248pengine_portray_clause(Term) :- 249 portray_clause(Term). 250 251 252 /******************************* 253 * PRINT MESSAGE * 254 *******************************/ 255 256:- multifile user:message_hook/3.
263user:message_hook(Term, Kind, Lines) :- 264 Kind \== silent, 265 pengine_self(_), 266 atom_concat('msg-', Kind, Class), 267 phrase(html(pre(class(['prolog-message', Class]), 268 \message_lines(Lines))), Tokens), 269 with_output_to(string(HTMlString), print_html(Tokens)), 270 ( source_location(File, Line) 271 -> Src = File:Line 272 ; Src = (-) 273 ), 274 pengine_output(message(Term, Kind, HTMlString, Src)). 275 276message_lines([]) --> []. 277message_lines([nl|T]) --> 278 !, 279 html('\n'), % we are in a <pre> environment 280 message_lines(T). 281message_lines([flush]) --> 282 []. 283message_lines([H|T]) --> 284 !, 285 html(H), 286 message_lines(T). 287 288 289 /******************************* 290 * INPUT * 291 *******************************/ 292 293pengine_read(Term) :- 294 pengine_input, 295 !, 296 prompt(Prompt, Prompt), 297 pengine_input(Prompt, Term). 298pengine_read(Term) :- 299 read(Term). 300 301pengine_read_line_to_string(From, String) :- 302 pengine_input, 303 !, 304 must_be(oneof([current_input,user_input]), From), 305 ( prompt(Prompt, Prompt), 306 Prompt \== '' 307 -> true 308 ; Prompt = 'line> ' 309 ), 310 pengine_input(_{type: console, prompt:Prompt}, StringNL), 311 string_concat(String, "\n", StringNL). 312pengine_read_line_to_string(From, String) :- 313 read_line_to_string(From, String). 314 315pengine_read_line_to_codes(From, Codes) :- 316 pengine_read_line_to_string(From, String), 317 string_codes(String, Codes). 318 319 320 /******************************* 321 * HTML * 322 *******************************/ 323 324lines([], _) --> []. 325lines([H|T], Class) --> 326 html(span(class(Class), H)), 327 ( { T == [] } 328 -> [] 329 ; html(br([])), 330 lines(T, Class) 331 ).
338send_html(HTML) :-
339 phrase(html(HTML), Tokens),
340 with_output_to(string(HTMlString), print_html(Tokens)),
341 pengine_output(HTMlString).
348pengine_module(Module) :- 349 pengine_self(Pengine), 350 !, 351 pengine_property(Pengine, module(Module)). 352pengine_module(user). 353 354 /******************************* 355 * OUTPUT FORMAT * 356 *******************************/
385:- multifile
386 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.)403penginesevent_to_json(success(ID, Answers0, Projection, Time, More), JSON, 404 'json-s') :- 405 !, 406 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More}, 407 maplist(answer_to_json_strings(ID), Answers0, Answers), 408 add_projection(Projection, JSON0, JSON). 409penginesevent_to_json(output(ID, Term), JSON, 'json-s') :- 410 !, 411 map_output(ID, Term, JSON). 412 413add_projection([], JSON, JSON) :- !. 414add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
422answer_to_json_strings(Pengine, DictIn, DictOut) :- 423 dict_pairs(DictIn, Tag, Pairs), 424 maplist(term_string_value(Pengine), Pairs, BindingsOut), 425 dict_pairs(DictOut, Tag, BindingsOut). 426 427term_string_value(Pengine, N-V, N-A) :- 428 with_output_to(string(A), 429 write_term(V, 430 [ module(Pengine), 431 quoted(true) 432 ])).
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.
446penginesevent_to_json(success(ID, Answers0, Projection, Time, More), 447 JSON, 'json-html') :- 448 !, 449 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More}, 450 maplist(map_answer(ID), Answers0, ResVars, Answers), 451 add_projection(Projection, ResVars, JSON0, JSON). 452penginesevent_to_json(output(ID, Term), JSON, 'json-html') :- 453 !, 454 map_output(ID, Term, JSON). 455 456map_answer(ID, Bindings0, ResVars, Answer) :- 457 dict_bindings(Bindings0, Bindings1), 458 select_residuals(Bindings1, Bindings2, ResVars, Residuals0), 459 append(Residuals0, Residuals1), 460 prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1, 461 ID:Residuals-_HiddenResiduals), 462 maplist(binding_to_html(ID), Bindings3, VarBindings), 463 ( Residuals == [] 464 -> Answer = json{variables:VarBindings} 465 ; residuals_html(Residuals, ID, ResHTML), 466 Answer = json{variables:VarBindings, residuals:ResHTML} 467 ). 468 469residuals_html([], _, []). 470residuals_html([H0|T0], Module, [H|T]) :- 471 term_html_string(H0, [], Module, H, [priority(999)]), 472 residuals_html(T0, Module, T). 473 474dict_bindings(Dict, Bindings) :- 475 dict_pairs(Dict, _Tag, Pairs), 476 maplist([N-V,N=V]>>true, Pairs, Bindings). 477 478select_residuals([], [], [], []). 479select_residuals([H|T], Bindings, Vars, Residuals) :- 480 binding_residual(H, Var, Residual), 481 !, 482 Vars = [Var|TV], 483 Residuals = [Residual|TR], 484 select_residuals(T, Bindings, TV, TR). 485select_residuals([H|T0], [H|T], Vars, Residuals) :- 486 select_residuals(T0, T, Vars, Residuals). 487 488binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :- 489 is_list(Residuals). 490binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :- 491 is_list(Residuals). 492binding_residual('Residual' = '$residual'(Residual), 'Residual', [Residual]) :- 493 callable(Residual). 494 495add_projection(-, _, JSON, JSON) :- !. 496add_projection(VarNames0, ResVars0, JSON0, JSON) :- 497 append(ResVars0, ResVars1), 498 sort(ResVars1, ResVars), 499 subtract(VarNames0, ResVars, VarNames), 500 add_projection(VarNames, JSON0, JSON).
511binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
512 JSON0 = json{variables:Vars, value:HTMLString},
513 term_html_string(Term, Vars, ID, HTMLString, [priority(699)]),
514 ( Substitutions == []
515 -> JSON = JSON0
516 ; maplist(subst_to_html(ID), Substitutions, HTMLSubst),
517 JSON = JSON0.put(substitutions, HTMLSubst)
518 ).
527term_html_string(Term, Vars, Module, HTMLString, Options) :-
528 setting(write_options, WOptions),
529 merge_options(WOptions,
530 [ quoted(true),
531 numbervars(true),
532 module(Module)
533 | Options
534 ], WriteOptions),
535 phrase(term_html(Term, Vars, WriteOptions), Tokens),
536 with_output_to(string(HTMLString), print_html(Tokens)).
548:- multifile binding_term//3. 549 550term_html(Term, Vars, WriteOptions) --> 551 { nonvar(Term) }, 552 binding_term(Term, Vars, WriteOptions), 553 !. 554term_html(Term, _Vars, WriteOptions) --> 555 term(Term, WriteOptions).
562subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :- 563 !, 564 term_html_string(Value, [Name], ID, HTMLString, [priority(699)]). 565subst_to_html(_, Term, _) :- 566 assertion(Term = '$VAR'(_)).
573map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :- 574 atomic(HTMLString), 575 !, 576 JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString}, 577 pengines:add_error_details(Term, JSON0, JSON1), 578 ( Src = File:Line, 579 \+ JSON1.get(location) = _ 580 -> JSON = JSON1.put(_{location:_{file:File, line:Line}}) 581 ; JSON = JSON1 582 ). 583map_output(ID, Term, json{event:output, id:ID, data:Data}) :- 584 ( atomic(Term) 585 -> Data = Term 586 ; is_dict(Term, json), 587 ground(json) % TBD: Check proper JSON object? 588 -> Data = Term 589 ; term_string(Term, Data) 590 ). 591 592 593 /******************************* 594 * SANDBOXING * 595 *******************************/ 596 597:- multifile 598 sandbox:safe_primitive/1, % Goal 599 sandbox:safe_meta/2. % Goal, Called 600 601sandbox:safe_primitive(pengines_io:pengine_listing(_)). 602sandbox:safe_primitive(pengines_io:pengine_nl). 603sandbox:safe_primitive(pengines_io:pengine_print(_)). 604sandbox:safe_primitive(pengines_io:pengine_write(_)). 605sandbox:safe_primitive(pengines_io:pengine_read(_)). 606sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)). 607sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)). 608sandbox:safe_primitive(pengines_io:pengine_writeln(_)). 609sandbox:safe_primitive(pengines_io:pengine_writeq(_)). 610sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)). 611sandbox:safe_primitive(system:write_term(_,_)). 612sandbox:safe_primitive(system:prompt(_,_)). 613sandbox:safe_primitive(system:statistics(_,_)). 614 615sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :- 616 sandbox:format_calls(Format, Args, Calls). 617 618 619 /******************************* 620 * REDEFINITION * 621 *******************************/
628pengine_io_predicate(writeln(_)). 629pengine_io_predicate(nl). 630pengine_io_predicate(flush_output). 631pengine_io_predicate(format(_)). 632pengine_io_predicate(format(_,_)). 633pengine_io_predicate(read(_)). 634pengine_io_predicate(read_line_to_string(_,_)). 635pengine_io_predicate(read_line_to_codes(_,_)). 636pengine_io_predicate(write_term(_,_)). 637pengine_io_predicate(write(_)). 638pengine_io_predicate(writeq(_)). 639pengine_io_predicate(display(_)). 640pengine_io_predicate(print(_)). 641pengine_io_predicate(write_canonical(_)). 642pengine_io_predicate(listing). 643pengine_io_predicate(listing(_)). 644pengine_io_predicate(portray_clause(_)). 645 646term_expansion(pengine_io_goal_expansion(_,_), 647 Clauses) :- 648 findall(Clause, io_mapping(Clause), Clauses). 649 650io_mapping(pengine_io_goal_expansion(Head, Mapped)) :- 651 pengine_io_predicate(Head), 652 Head =.. [Name|Args], 653 atom_concat(pengine_, Name, BodyName), 654 Mapped =.. [BodyName|Args]. 655 656pengine_io_goal_expansion(_, _). 657 658 659 /******************************* 660 * REBIND PENGINE I/O * 661 *******************************/ 662 663:- public 664 stream_write/2, 665 stream_read/2, 666 stream_close/1. 667 668:- thread_local 669 pengine_io/2. 670 671stream_write(_Stream, Out) :- 672 send_html(pre(class(console), Out)). 673stream_read(_Stream, Data) :- 674 prompt(Prompt, Prompt), 675 pengine_input(_{type:console, prompt:Prompt}, Data). 676stream_close(_Stream).
686pengine_bind_user_streams :- 687 Err = Out, 688 open_prolog_stream(pengines_io, write, Out, []), 689 set_stream(Out, buffer(line)), 690 open_prolog_stream(pengines_io, read, In, []), 691 set_stream(In, alias(user_input)), 692 set_stream(Out, alias(user_output)), 693 set_stream(Err, alias(user_error)), 694 set_stream(In, alias(current_input)), 695 set_stream(Out, alias(current_output)), 696 assertz(pengine_io(In, Out)), 697 thread_at_exit(close_io). 698 699close_io :- 700 retract(pengine_io(In, Out)), 701 !, 702 close(In, [force(true)]), 703 close(Out, [force(true)]). 704close_io.
711pengine_output :- 712 current_output(Out), 713 pengine_io(_, Out). 714 715pengine_input :- 716 current_input(In), 717 pengine_io(In, _).
725pengine_bind_io_to_html(Module) :- 726 forall(pengine_io_predicate(Head), 727 bind_io(Head, Module)), 728 pengine_bind_user_streams. 729 730bind_io(Head, Module) :- 731 prompt(_, ''), 732 redefine_system_predicate(Module:Head), 733 functor(Head, Name, Arity), 734 Head =.. [Name|Args], 735 atom_concat(pengine_, Name, BodyName), 736 Body =.. [BodyName|Args], 737 assertz(Module:(Head :- Body)), 738 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.
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:
*/