34
35:- module(pengines_io,
36 [ pengine_writeln/1, 37 pengine_nl/0,
38 pengine_flush_output/0,
39 pengine_format/1, 40 pengine_format/2, 41
42 pengine_write_term/2, 43 pengine_write/1, 44 pengine_writeq/1, 45 pengine_display/1, 46 pengine_print/1, 47 pengine_write_canonical/1, 48
49 pengine_listing/0,
50 pengine_listing/1, 51 pengine_portray_clause/1, 52
53 pengine_read/1, 54 pengine_read_line_to_string/2, 55 pengine_read_line_to_codes/2, 56
57 pengine_io_predicate/1, 58 pengine_bind_io_to_html/1, 59 pengine_io_goal_expansion/2 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(html). 77
78:- meta_predicate
79 pengine_format(+,:). 80
113
114:- setting(write_options, list(any), [max_depth(1000)],
115 'Additional options for stringifying Prolog results'). 116
117
118 121
125
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).
138
142
143pengine_nl :-
144 pengine_output,
145 !,
146 send_html(br([])).
147pengine_nl :-
148 nl.
149
154
155pengine_flush_output :-
156 pengine_output,
157 !.
158pengine_flush_output :-
159 flush_output.
160
168
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).
177
185
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).
202
210
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 226
232
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 255
256:- multifile user:message_hook/3. 257
262
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'), 280 message_lines(T).
281message_lines([flush]) -->
282 [].
283message_lines([H|T]) -->
284 !,
285 html(H),
286 message_lines(T).
287
288
289 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 323
324lines([], _) --> [].
325lines([H|T], Class) -->
326 html(span(class(Class), H)),
327 ( { T == [] }
328 -> []
329 ; html(br([])),
330 lines(T, Class)
331 ).
332
337
338send_html(HTML) :-
339 phrase(html(HTML), Tokens),
340 with_output_to(string(HTMlString), print_html(Tokens)),
341 pengine_output(HTMlString).
342
343
347
348pengine_module(Module) :-
349 pengine_self(Pengine),
350 !,
351 pengine_property(Pengine, module(Module)).
352pengine_module(user).
353
354 357
384
385:- multifile
386 pengines:event_to_json/3. 387
402
403pengines:event_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).
409pengines:event_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)).
415
416
421
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 ])).
433
445
446pengines:event_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).
452pengines:event_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).
501
502
510
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 ).
519
526
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)).
537
547
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).
556
561
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'(_)).
567
568
572
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) 588 -> Data = Term
589 ; term_string(Term, Data)
590 ).
591
592
593 596
597:- multifile
598 sandbox:safe_primitive/1, 599 sandbox:safe_meta/2. 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 622
627
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 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).
677
685
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.
705
710
711pengine_output :-
712 current_output(Out),
713 pengine_io(_, Out).
714
715pengine_input :-
716 current_input(In),
717 pengine_io(In, _).
718
719
724
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])