36
37:- module(pengines_io,
38 [ pengine_writeln/1, 39 pengine_nl/0,
40 pengine_tab/1,
41 pengine_flush_output/0,
42 pengine_format/1, 43 pengine_format/2, 44
45 pengine_write_term/2, 46 pengine_write/1, 47 pengine_writeq/1, 48 pengine_display/1, 49 pengine_print/1, 50 pengine_write_canonical/1, 51
52 pengine_listing/0,
53 pengine_listing/1, 54 pengine_portray_clause/1, 55
56 pengine_read/1, 57 pengine_read_line_to_string/2, 58 pengine_read_line_to_codes/2, 59
60 pengine_io_predicate/1, 61 pengine_bind_io_to_html/1, 62 pengine_io_goal_expansion/2, 63
64 message_lines_to_html/3 65 ]). 66:- autoload(library(apply),[foldl/4,maplist/3,maplist/4]). 67:- autoload(library(backcomp),[thread_at_exit/1]). 68:- use_module(library(debug),[assertion/1]). 69:- autoload(library(error),[must_be/2]). 70:- autoload(library(listing),[listing/1,portray_clause/1]). 71:- autoload(library(lists),[append/2,append/3,subtract/3]). 72:- autoload(library(option),[option/3,merge_options/3]). 73:- autoload(library(pengines),
74 [ pengine_self/1,
75 pengine_output/1,
76 pengine_input/2,
77 pengine_property/2
78 ]). 79:- autoload(library(prolog_stream),[open_prolog_stream/4]). 80:- autoload(library(readutil),[read_line_to_string/2]). 81:- autoload(library(http/term_html),[term/4]). 82
83:- use_module(library(yall),[(>>)/4]). 84:- use_module(library(http/html_write),[html/3,print_html/1, op(_,_,_)]). 85:- use_module(library(settings),[setting/4,setting/2]). 86
87:- use_module(library(sandbox), []). 88:- autoload(library(thread), [call_in_thread/2]). 89
90:- html_meta send_html(html). 91:- public send_html/1. 92
93:- meta_predicate
94 pengine_format(+,:). 95
128
129:- setting(write_options, list(any), [max_depth(1000)],
130 'Additional options for stringifying Prolog results'). 131
132
133 136
140
141pengine_writeln(Term) :-
142 pengine_output,
143 !,
144 pengine_module(Module),
145 send_html(span(class(writeln),
146 [ \term(Term,
147 [ module(Module)
148 ]),
149 br([])
150 ])).
151pengine_writeln(Term) :-
152 writeln(Term).
153
157
158pengine_nl :-
159 pengine_output,
160 !,
161 send_html(br([])).
162pengine_nl :-
163 nl.
164
168
169pengine_tab(Expr) :-
170 pengine_output,
171 !,
172 N is Expr,
173 length(List, N),
174 maplist(=(&(nbsp)), List),
175 send_html(List).
176pengine_tab(N) :-
177 tab(N).
178
179
184
185pengine_flush_output :-
186 pengine_output,
187 \+ pengine_io(_,_),
188 !.
189pengine_flush_output :-
190 flush_output.
191
192:- multifile
193 pengines:pengine_flush_output_hook/0. 194
195pengines:pengine_flush_output_hook :-
196 pengine_flush_output.
197
205
206pengine_write_term(Term, Options) :-
207 pengine_output,
208 !,
209 option(class(Class), Options, write),
210 pengine_module(Module),
211 send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
212pengine_write_term(Term, Options) :-
213 write_term(Term, Options).
214
222
223pengine_write(Term) :-
224 pengine_write_term(Term, [numbervars(true)]).
225pengine_writeq(Term) :-
226 pengine_write_term(Term, [quoted(true), numbervars(true)]).
227pengine_display(Term) :-
228 pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
229pengine_print(Term) :-
230 current_prolog_flag(print_write_options, Options),
231 pengine_write_term(Term, Options).
232pengine_write_canonical(Term) :-
233 pengine_output,
234 !,
235 with_output_to(string(String), write_canonical(Term)),
236 send_html(span(class([write, cononical]), String)).
237pengine_write_canonical(Term) :-
238 write_canonical(Term).
239
247
248pengine_format(Format) :-
249 pengine_format(Format, []).
250pengine_format(Format, Args) :-
251 pengine_output,
252 !,
253 format(string(String), Format, Args),
254 split_string(String, "\n", "", Lines),
255 send_html(\lines(Lines, format)).
256pengine_format(Format, Args) :-
257 format(Format, Args).
258
259
260 263
269
270pengine_listing :-
271 pengine_listing(_).
272
273pengine_listing(Spec) :-
274 pengine_self(Module),
275 with_output_to(string(String), listing(Module:Spec)),
276 split_string(String, "", "\n", [Pre]),
277 send_html(pre(class(listing), Pre)).
278
279pengine_portray_clause(Term) :-
280 pengine_output,
281 !,
282 with_output_to(string(String), portray_clause(Term)),
283 split_string(String, "", "\n", [Pre]),
284 send_html(pre(class(listing), Pre)).
285pengine_portray_clause(Term) :-
286 portray_clause(Term).
287
288
289 292
293:- multifile user:message_hook/3. 294
299
300user:message_hook(Term, Kind, Lines) :-
301 Kind \== silent,
302 pengine_self(_),
303 atom_concat('msg-', Kind, Class),
304 message_lines_to_html(Lines, [Class], HTMlString),
305 ( source_location(File, Line)
306 -> Src = File:Line
307 ; Src = (-)
308 ),
309 pengine_output(message(Term, Kind, HTMlString, Src)).
310
316
317message_lines_to_html(Lines, Classes, HTMlString) :-
318 phrase(html(pre(class(['prolog-message'|Classes]),
319 \message_lines(Lines))), Tokens),
320 with_output_to(string(HTMlString), print_html(Tokens)).
321
322message_lines([]) -->
323 !.
324message_lines([nl|T]) -->
325 !,
326 html('\n'), 327 message_lines(T).
328message_lines([flush]) -->
329 !.
330message_lines([ansi(Attributes, Fmt, Args)|T]) -->
331 !,
332 { is_list(Attributes)
333 -> foldl(style, Attributes, Fmt-Args, HTML)
334 ; style(Attributes, Fmt-Args, HTML)
335 },
336 html(HTML),
337 message_lines(T).
338message_lines([url(Pos)|T]) -->
339 !,
340 location(Pos),
341 message_lines(T).
342message_lines([url(HREF, Label)|T]) -->
343 !,
344 html(a(href(HREF),Label)),
345 message_lines(T).
346message_lines([H|T]) -->
347 html(H),
348 message_lines(T).
349
350location(File:Line:Column) -->
351 !,
352 html([File, :, Line, :, Column]).
353location(File:Line) -->
354 !,
355 html([File, :, Line]).
356location(File) -->
357 html([File]).
358
359style(bold, Content, b(Content)) :- !.
360style(fg(default), Content, span(style('color: black'), Content)) :- !.
361style(fg(Color), Content, span(style('color:'+Color), Content)) :- !.
362style(_, Content, Content).
363
364
365 368
369pengine_read(Term) :-
370 pengine_input,
371 !,
372 prompt(Prompt, Prompt),
373 pengine_input(Prompt, Term).
374pengine_read(Term) :-
375 read(Term).
376
377pengine_read_line_to_string(From, String) :-
378 pengine_input,
379 !,
380 must_be(oneof([current_input,user_input]), From),
381 ( prompt(Prompt, Prompt),
382 Prompt \== ''
383 -> true
384 ; Prompt = 'line> '
385 ),
386 pengine_input(_{type: console, prompt:Prompt}, StringNL),
387 string_concat(String, "\n", StringNL).
388pengine_read_line_to_string(From, String) :-
389 read_line_to_string(From, String).
390
391pengine_read_line_to_codes(From, Codes) :-
392 pengine_read_line_to_string(From, String),
393 string_codes(String, Codes).
394
395
396 399
400lines([], _) --> [].
401lines([H|T], Class) -->
402 html(span(class(Class), H)),
403 ( { T == [] }
404 -> []
405 ; html(br([])),
406 lines(T, Class)
407 ).
408
413
414send_html(HTML) :-
415 phrase(html(HTML), Tokens),
416 with_output_to(string(HTMlString), print_html(Tokens)),
417 pengine_output(HTMlString).
418
419
423
424pengine_module(Module) :-
425 pengine_self(Pengine),
426 !,
427 pengine_property(Pengine, module(Module)).
428pengine_module(user).
429
430 433
460
461:- multifile
462 pengines:event_to_json/3. 463
478
479pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
480 'json-s') :-
481 !,
482 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
483 maplist(answer_to_json_strings(ID), Answers0, Answers),
484 add_projection(Projection, JSON0, JSON).
485pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
486 !,
487 map_output(ID, Term, JSON).
488
489add_projection([], JSON, JSON) :- !.
490add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
491
492
497
498answer_to_json_strings(Pengine, DictIn, DictOut) :-
499 dict_pairs(DictIn, Tag, Pairs),
500 maplist(term_string_value(Pengine), Pairs, BindingsOut),
501 dict_pairs(DictOut, Tag, BindingsOut).
502
503term_string_value(Pengine, N-V, N-A) :-
504 with_output_to(string(A),
505 write_term(V,
506 [ module(Pengine),
507 quoted(true)
508 ])).
509
521
522pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
523 JSON, 'json-html') :-
524 !,
525 JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
526 maplist(map_answer(ID), Answers0, ResVars, Answers),
527 add_projection(Projection, ResVars, JSON0, JSON).
528pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
529 !,
530 map_output(ID, Term, JSON).
531
532map_answer(ID, Bindings0, ResVars, Answer) :-
533 dict_bindings(Bindings0, Bindings1),
534 select_residuals(Bindings1, Bindings2, ResVars, Residuals0, Clauses),
535 append(Residuals0, Residuals1),
536 prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
537 ID:Residuals-_HiddenResiduals),
538 maplist(binding_to_html(ID), Bindings3, VarBindings),
539 final_answer(ID, VarBindings, Residuals, Clauses, Answer).
540
541final_answer(_Id, VarBindings, [], [], Answer) :-
542 !,
543 Answer = json{variables:VarBindings}.
544final_answer(ID, VarBindings, Residuals, [], Answer) :-
545 !,
546 residuals_html(Residuals, ID, ResHTML),
547 Answer = json{variables:VarBindings, residuals:ResHTML}.
548final_answer(ID, VarBindings, [], Clauses, Answer) :-
549 !,
550 clauses_html(Clauses, ID, ClausesHTML),
551 Answer = json{variables:VarBindings, wfs_residual_program:ClausesHTML}.
552final_answer(ID, VarBindings, Residuals, Clauses, Answer) :-
553 !,
554 residuals_html(Residuals, ID, ResHTML),
555 clauses_html(Clauses, ID, ClausesHTML),
556 Answer = json{variables:VarBindings,
557 residuals:ResHTML,
558 wfs_residual_program:ClausesHTML}.
559
560residuals_html([], _, []).
561residuals_html([H0|T0], Module, [H|T]) :-
562 term_html_string(H0, [], Module, H, [priority(999)]),
563 residuals_html(T0, Module, T).
564
565clauses_html(Clauses, _ID, HTMLString) :-
566 with_output_to(string(Program), list_clauses(Clauses)),
567 phrase(html(pre([class('wfs-residual-program')], Program)), Tokens),
568 with_output_to(string(HTMLString), print_html(Tokens)).
569
570list_clauses([]).
571list_clauses([H|T]) :-
572 ( system_undefined(H)
573 -> true
574 ; portray_clause(H)
575 ),
576 list_clauses(T).
577
578system_undefined((undefined :- tnot(undefined))).
579system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
580system_undefined((radial_restraint :- tnot(radial_restraint))).
581
582dict_bindings(Dict, Bindings) :-
583 dict_pairs(Dict, _Tag, Pairs),
584 maplist([N-V,N=V]>>true, Pairs, Bindings).
585
586select_residuals([], [], [], [], []).
587select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
588 binding_residual(H, Var, Residual),
589 !,
590 Vars = [Var|TV],
591 Residuals = [Residual|TR],
592 select_residuals(T, Bindings, TV, TR, Clauses).
593select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
594 binding_residual_clauses(H, Var, Delays, Clauses0),
595 !,
596 Vars = [Var|TV],
597 Residuals = [Delays|TR],
598 append(Clauses0, CT, Clauses),
599 select_residuals(T, Bindings, TV, TR, CT).
600select_residuals([H|T0], [H|T], Vars, Residuals, Clauses) :-
601 select_residuals(T0, T, Vars, Residuals, Clauses).
602
603binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
604 is_list(Residuals).
605binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
606 is_list(Residuals).
607binding_residual('Residual' = '$residual'(Residual), 'Residual', [Residual]) :-
608 callable(Residual).
609
610binding_residual_clauses(
611 '_wfs_residual_program' = '$wfs_residual_program'(Delays, Clauses),
612 '_wfs_residual_program', Residuals, Clauses) :-
613 phrase(delay_list(Delays), Residuals).
614
615delay_list(true) --> !.
616delay_list((A,B)) --> !, delay_list(A), delay_list(B).
617delay_list(M:A) --> !, [M:'$wfs_undefined'(A)].
618delay_list(A) --> ['$wfs_undefined'(A)].
619
620add_projection(-, _, JSON, JSON) :- !.
621add_projection(VarNames0, ResVars0, JSON0, JSON) :-
622 append(ResVars0, ResVars1),
623 sort(ResVars1, ResVars),
624 subtract(VarNames0, ResVars, VarNames),
625 add_projection(VarNames, JSON0, JSON).
626
627
635
636binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
637 JSON0 = json{variables:Vars, value:HTMLString},
638 binding_write_options(ID, Options),
639 term_html_string(Term, Vars, ID, HTMLString, Options),
640 ( Substitutions == []
641 -> JSON = JSON0
642 ; maplist(subst_to_html(ID), Substitutions, HTMLSubst),
643 JSON = JSON0.put(substitutions, HTMLSubst)
644 ).
645
646binding_write_options(Pengine, Options) :-
647 ( current_predicate(Pengine:screen_property/1),
648 Pengine:screen_property(tabled(true))
649 -> Options = []
650 ; Options = [priority(699)]
651 ).
652
659
660term_html_string(Term, Vars, Module, HTMLString, Options) :-
661 setting(write_options, WOptions),
662 merge_options(WOptions,
663 [ quoted(true),
664 numbervars(true),
665 module(Module)
666 | Options
667 ], WriteOptions),
668 phrase(term_html(Term, Vars, WriteOptions), Tokens),
669 with_output_to(string(HTMLString), print_html(Tokens)).
670
680
681:- multifile binding_term//3. 682
683term_html(Term, Vars, WriteOptions) -->
684 { nonvar(Term) },
685 binding_term(Term, Vars, WriteOptions),
686 !.
687term_html(Undef, _Vars, WriteOptions) -->
688 { nonvar(Undef),
689 Undef = '$wfs_undefined'(Term),
690 !
691 },
692 html(span(class(wfs_undefined), \term(Term, WriteOptions))).
693term_html(Term, _Vars, WriteOptions) -->
694 term(Term, WriteOptions).
695
700
701subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
702 !,
703 binding_write_options(ID, Options),
704 term_html_string(Value, [Name], ID, HTMLString, Options).
705subst_to_html(_, Term, _) :-
706 assertion(Term = '$VAR'(_)).
707
708
712
713map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
714 atomic(HTMLString),
715 !,
716 JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
717 pengines:add_error_details(Term, JSON0, JSON1),
718 ( Src = File:Line,
719 \+ JSON1.get(location) = _
720 -> JSON = JSON1.put(_{location:_{file:File, line:Line}})
721 ; JSON = JSON1
722 ).
723map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
724 ( atomic(Term)
725 -> Data = Term
726 ; is_dict(Term, json),
727 ground(json) 728 -> Data = Term
729 ; term_string(Term, Data)
730 ).
731
732
736
737:- multifile
738 prolog_help:show_html_hook/1. 739
740prolog_help:show_html_hook(HTML) :-
741 pengine_output,
742 pengine_output(HTML).
743
744
745 748
749:- multifile
750 sandbox:safe_primitive/1, 751 sandbox:safe_meta/2. 752
753sandbox:safe_primitive(pengines_io:pengine_listing(_)).
754sandbox:safe_primitive(pengines_io:pengine_nl).
755sandbox:safe_primitive(pengines_io:pengine_tab(_)).
756sandbox:safe_primitive(pengines_io:pengine_flush_output).
757sandbox:safe_primitive(pengines_io:pengine_print(_)).
758sandbox:safe_primitive(pengines_io:pengine_write(_)).
759sandbox:safe_primitive(pengines_io:pengine_read(_)).
760sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)).
761sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)).
762sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
763sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
764sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
765sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
766sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
767sandbox:safe_primitive(system:write_term(_,_)).
768sandbox:safe_primitive(system:prompt(_,_)).
769sandbox:safe_primitive(system:statistics(_,_)).
770sandbox:safe_primitive(system:put_code(_)).
771sandbox:safe_primitive(system:put_char(_)).
772
773sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
774 sandbox:format_calls(Format, Args, Calls).
775
776
777 780
785
786pengine_io_predicate(writeln(_)).
787pengine_io_predicate(nl).
788pengine_io_predicate(tab(_)).
789pengine_io_predicate(flush_output).
790pengine_io_predicate(format(_)).
791pengine_io_predicate(format(_,_)).
792pengine_io_predicate(read(_)).
793pengine_io_predicate(read_line_to_string(_,_)).
794pengine_io_predicate(read_line_to_codes(_,_)).
795pengine_io_predicate(write_term(_,_)).
796pengine_io_predicate(write(_)).
797pengine_io_predicate(writeq(_)).
798pengine_io_predicate(display(_)).
799pengine_io_predicate(print(_)).
800pengine_io_predicate(write_canonical(_)).
801pengine_io_predicate(listing).
802pengine_io_predicate(listing(_)).
803pengine_io_predicate(portray_clause(_)).
804
805term_expansion(pengine_io_goal_expansion(_,_),
806 Clauses) :-
807 findall(Clause, io_mapping(Clause), Clauses).
808
809io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
810 pengine_io_predicate(Head),
811 Head =.. [Name|Args],
812 atom_concat(pengine_, Name, BodyName),
813 Mapped =.. [BodyName|Args].
814
815pengine_io_goal_expansion(_, _).
816
817
818 821
822:- public
823 stream_write/2,
824 stream_read/2,
825 stream_close/1. 826
827:- thread_local
828 pengine_io/2. 829
830stream_write(Stream, Out) :-
831 ( pengine_io(_,_)
832 -> send_html(pre(class(console), Out))
833 ; current_prolog_flag(pengine_main_thread, TID),
834 thread_signal(TID, stream_write(Stream, Out))
835 ).
836stream_read(Stream, Data) :-
837 ( pengine_io(_,_)
838 -> prompt(Prompt, Prompt),
839 pengine_input(_{type:console, prompt:Prompt}, Data)
840 ; current_prolog_flag(pengine_main_thread, TID),
841 call_in_thread(TID, stream_read(Stream, Data))
842 ).
843stream_close(_Stream).
844
852
853pengine_bind_user_streams :-
854 Err = Out,
855 open_prolog_stream(pengines_io, write, Out, []),
856 set_stream(Out, buffer(line)),
857 open_prolog_stream(pengines_io, read, In, []),
858 set_stream(In, alias(user_input)),
859 set_stream(Out, alias(user_output)),
860 set_stream(Err, alias(user_error)),
861 set_stream(In, alias(current_input)),
862 set_stream(Out, alias(current_output)),
863 assertz(pengine_io(In, Out)),
864 thread_self(Me),
865 thread_property(Me, id(Id)),
866 set_prolog_flag(pengine_main_thread, Id),
867 thread_at_exit(close_io).
868
869close_io :-
870 retract(pengine_io(In, Out)),
871 !,
872 close(In, [force(true)]),
873 close(Out, [force(true)]).
874close_io.
875
880
881pengine_output :-
882 current_output(Out),
883 pengine_io(_, Out).
884
885pengine_input :-
886 current_input(In),
887 pengine_io(In, _).
888
889
894
895pengine_bind_io_to_html(Module) :-
896 forall(pengine_io_predicate(Head),
897 bind_io(Head, Module)),
898 pengine_bind_user_streams.
899
900bind_io(Head, Module) :-
901 prompt(_, ''),
902 redefine_system_predicate(Module:Head),
903 functor(Head, Name, Arity),
904 Head =.. [Name|Args],
905 atom_concat(pengine_, Name, BodyName),
906 Body =.. [BodyName|Args],
907 assertz(Module:(Head :- Body)),
908 compile_predicates([Module:Name/Arity])