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])