35
36:- module(pengines_io,
37 [ pengine_writeln/1, 38 pengine_nl/0,
39 pengine_flush_output/0,
40 pengine_format/1, 41 pengine_format/2, 42
43 pengine_write_term/2, 44 pengine_write/1, 45 pengine_writeq/1, 46 pengine_display/1, 47 pengine_print/1, 48 pengine_write_canonical/1, 49
50 pengine_listing/0,
51 pengine_listing/1, 52 pengine_portray_clause/1, 53
54 pengine_read/1, 55 pengine_read_line_to_string/2, 56 pengine_read_line_to_codes/2, 57
58 pengine_io_predicate/1, 59 pengine_bind_io_to_html/1, 60 pengine_io_goal_expansion/2, 61
62 message_lines_to_html/3 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(html). 80
81:- meta_predicate
82 pengine_format(+,:). 83
116
117:- setting(write_options, list(any), [max_depth(1000)],
118 'Additional options for stringifying Prolog results'). 119
120
121 124
128
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).
141
145
146pengine_nl :-
147 pengine_output,
148 !,
149 send_html(br([])).
150pengine_nl :-
151 nl.
152
157
158pengine_flush_output :-
159 pengine_output,
160 !.
161pengine_flush_output :-
162 flush_output.
163
171
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).
180
188
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).
205
213
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 229
235
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 258
259:- multifile user:message_hook/3. 260
265
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)).
276
282
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'), 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 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 348
349lines([], _) --> [].
350lines([H|T], Class) -->
351 html(span(class(Class), H)),
352 ( { T == [] }
353 -> []
354 ; html(br([])),
355 lines(T, Class)
356 ).
357
362
363send_html(HTML) :-
364 phrase(html(HTML), Tokens),
365 with_output_to(string(HTMlString), print_html(Tokens)),
366 pengine_output(HTMlString).
367
368
372
373pengine_module(Module) :-
374 pengine_self(Pengine),
375 !,
376 pengine_property(Pengine, module(Module)).
377pengine_module(user).
378
379 382
409
410:- multifile
411 pengines:event_to_json/3. 412
427
428pengines:event_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).
434pengines:event_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)).
440
441
446
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 ])).
458
470
471pengines:event_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).
477pengines:event_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).
526
527
535
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 ).
544
551
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)).
562
572
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).
581
586
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'(_)).
592
593
597
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) 613 -> Data = Term
614 ; term_string(Term, Data)
615 ).
616
617
621
622:- multifile
623 prolog_help:show_html_hook/1. 624
625prolog_help:show_html_hook(HTML) :-
626 pengine_output,
627 pengine_output(HTML).
628
629
630 633
634:- multifile
635 sandbox:safe_primitive/1, 636 sandbox:safe_meta/2. 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 662
667
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 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).
717
725
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.
745
750
751pengine_output :-
752 current_output(Out),
753 pengine_io(_, Out).
754
755pengine_input :-
756 current_input(In),
757 pengine_io(In, _).
758
759
764
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])