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-2024, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(pengines_io,
   38          [ pengine_writeln/1,          % +Term
   39            pengine_nl/0,
   40            pengine_tab/1,
   41            pengine_flush_output/0,
   42            pengine_format/1,           % +Format
   43            pengine_format/2,           % +Format, +Args
   44
   45            pengine_write_term/2,       % +Term, +Options
   46            pengine_write/1,            % +Term
   47            pengine_writeq/1,           % +Term
   48            pengine_display/1,          % +Term
   49            pengine_print/1,            % +Term
   50            pengine_write_canonical/1,  % +Term
   51
   52            pengine_listing/0,
   53            pengine_listing/1,          % +Spec
   54            pengine_portray_clause/1,   % +Term
   55
   56            pengine_read/1,             % -Term
   57            pengine_read_line_to_string/2, % +Stream, -LineAsString
   58            pengine_read_line_to_codes/2, % +Stream, -LineAsCodes
   59
   60            pengine_io_predicate/1,     % ?Head
   61            pengine_bind_io_to_html/1,  % +Module
   62            pengine_io_goal_expansion/2,% +Goal, -Expanded
   63
   64            message_lines_to_html/3     % +Lines, +Classes, -HTML
   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
   96/** <module> Provide Prolog I/O for HTML clients
   97
   98This module redefines some of  the   standard  Prolog  I/O predicates to
   99behave transparently for HTML clients. It  provides two ways to redefine
  100the standard predicates: using goal_expansion/2   and  by redefining the
  101system predicates using redefine_system_predicate/1. The   latter is the
  102preferred route because it gives a more   predictable  trace to the user
  103and works regardless of the use of other expansion and meta-calling.
  104
  105*Redefining* works by redefining the system predicates in the context of
  106the pengine's module. This  is  configured   using  the  following  code
  107snippet.
  108
  109  ==
  110  :- pengine_application(myapp).
  111  :- use_module(myapp:library(pengines_io)).
  112  pengines:prepare_module(Module, myapp, _Options) :-
  113        pengines_io:pengine_bind_io_to_html(Module).
  114  ==
  115
  116*Using goal_expansion/2* works by  rewriting   the  corresponding  goals
  117using goal_expansion/2 and use the new   definition  to re-route I/O via
  118pengine_input/2 and pengine_output/1. A pengine  application is prepared
  119for using this module with the following code:
  120
  121  ==
  122  :- pengine_application(myapp).
  123  :- use_module(myapp:library(pengines_io)).
  124  myapp:goal_expansion(In,Out) :-
  125        pengine_io_goal_expansion(In, Out).
  126  ==
  127*/
  128
  129:- setting(write_options, list(any), [max_depth(1000)],
  130           'Additional options for stringifying Prolog results').  131
  132
  133                 /*******************************
  134                 *            OUTPUT            *
  135                 *******************************/
  136
  137%!  pengine_writeln(+Term)
  138%
  139%   Emit Term as <span class=writeln>Term<br></span>.
  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
  154%!  pengine_nl
  155%
  156%   Emit a <br/> to the pengine.
  157
  158pengine_nl :-
  159    pengine_output,
  160    !,
  161    send_html(br([])).
  162pengine_nl :-
  163    nl.
  164
  165%!  pengine_tab(+N)
  166%
  167%   Emit N spaces
  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
  180%!  pengine_flush_output
  181%
  182%   No-op.  Pengines do not use output buffering (maybe they should
  183%   though).
  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
  198%!  pengine_write_term(+Term, +Options)
  199%
  200%   Writes term as <span class=Class>Term</span>. In addition to the
  201%   options of write_term/2, these options are processed:
  202%
  203%     - class(+Class)
  204%       Specifies the class of the element.  Default is =write=.
  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
  215%!  pengine_write(+Term) is det.
  216%!  pengine_writeq(+Term) is det.
  217%!  pengine_display(+Term) is det.
  218%!  pengine_print(+Term) is det.
  219%!  pengine_write_canonical(+Term) is det.
  220%
  221%   Redirect the corresponding Prolog output predicates.
  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
  240%!  pengine_format(+Format) is det.
  241%!  pengine_format(+Format, +Args) is det.
  242%
  243%   As format/1,2. Emits a series  of   strings  with <br/> for each
  244%   newline encountered in the string.
  245%
  246%   @tbd: handle ~w, ~q, etc using term//2.  How can we do that??
  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                 /*******************************
  261                 *            LISTING           *
  262                 *******************************/
  263
  264%!  pengine_listing is det.
  265%!  pengine_listing(+Spec) is det.
  266%
  267%   List the content of the current pengine or a specified predicate
  268%   in the pengine.
  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                 /*******************************
  290                 *         PRINT MESSAGE        *
  291                 *******************************/
  292
  293:- multifile user:message_hook/3.  294
  295%!  user:message_hook(+Term, +Kind, +Lines) is semidet.
  296%
  297%   Send output from print_message/2 to   the  pengine. Messages are
  298%   embedded in a <pre class=msg-Kind></pre> environment.
  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
  311%!  message_lines_to_html(+MessageLines, +Classes, -HTMLString) is det.
  312%
  313%   Helper that translates the `Lines` argument from user:message_hook/3
  314%   into an HTML string. The  HTML  is   a  <pre>  object with the class
  315%   `'prolog-message'` and the given Classes.
  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'),                     % we are in a <pre> environment
  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                 /*******************************
  366                 *             INPUT            *
  367                 *******************************/
  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                 /*******************************
  397                 *             HTML             *
  398                 *******************************/
  399
  400lines([], _) --> [].
  401lines([H|T], Class) -->
  402    html(span(class(Class), H)),
  403    (   { T == [] }
  404    ->  []
  405    ;   html(br([])),
  406        lines(T, Class)
  407    ).
  408
  409%!  send_html(+HTML) is det.
  410%
  411%   Convert html//1 term into a string and send it to the client
  412%   using pengine_output/1.
  413
  414send_html(HTML) :-
  415    phrase(html(HTML), Tokens),
  416    with_output_to(string(HTMlString), print_html(Tokens)),
  417    pengine_output(HTMlString).
  418
  419
  420%!  pengine_module(-Module) is det.
  421%
  422%   Module (used for resolving operators).
  423
  424pengine_module(Module) :-
  425    pengine_self(Pengine),
  426    !,
  427    pengine_property(Pengine, module(Module)).
  428pengine_module(user).
  429
  430                 /*******************************
  431                 *        OUTPUT FORMAT         *
  432                 *******************************/
  433
  434%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames) is semidet.
  435%
  436%   Provide additional translations for  Prolog   terms  to  output.
  437%   Defines formats are:
  438%
  439%     * 'json-s'
  440%     _Simple_ or _string_ format: Prolog terms are sent using
  441%     quoted write.
  442%     * 'json-html'
  443%     Serialize responses as HTML string.  This is intended for
  444%     applications that emulate the Prolog toplevel.  This format
  445%     carries the following data:
  446%
  447%       - data
  448%         List if answers, where each answer is an object with
  449%         - variables
  450%           Array of objects, each describing a variable.  These
  451%           objects contain these fields:
  452%           - variables: Array of strings holding variable names
  453%           - value: HTML-ified value of the variables
  454%           - substitutions: Array of objects for substitutions
  455%             that break cycles holding:
  456%             - var: Name of the inserted variable
  457%             - value: HTML-ified value
  458%         - residuals
  459%           Array of strings representing HTML-ified residual goals.
  460
  461:- multifile
  462    pengines:event_to_json/3.  463
  464%!  pengines:event_to_json(+PrologEvent, -JSONEvent, +Format, +VarNames)
  465%
  466%   If Format equals `'json-s'` or  `'json-html'`, emit a simplified
  467%   JSON representation of the  data,   suitable  for notably SWISH.
  468%   This deals with Prolog answers and output messages. If a message
  469%   originates from print_message/3,  it   gets  several  additional
  470%   properties:
  471%
  472%     - message:Kind
  473%       Indicate the _kind_ of the message (=error=, =warning=,
  474%       etc.)
  475%     - location:_{file:File, line:Line, ch:CharPos}
  476%       If the message is related to a source location, indicate the
  477%       file and line and, if available, the character location.
  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
  493%!  answer_to_json_strings(+Pengine, +AnswerDictIn, -AnswerDict).
  494%
  495%   Translate answer dict with Prolog term   values into answer dict
  496%   with string values.
  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
  510%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames)
  511%
  512%   Implement translation of a Pengine event to =json-html= format. This
  513%   format represents the answer as JSON,  but the variable bindings are
  514%   (structured) HTML strings rather than JSON objects.
  515%
  516%   CHR residual goals are not  bound   to  the projection variables. We
  517%   hacked a bypass to fetch these by returning them in a variable named
  518%   `_residuals`, which must be bound to a term '$residuals'(List). Such
  519%   a variable is removed from  the   projection  and  added to residual
  520%   goals.
  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
  628%!  binding_to_html(+Pengine, +Binding, -Dict) is det.
  629%
  630%   Convert a variable binding into a JSON Dict. Note that this code
  631%   assumes that the module associated  with   Pengine  has the same
  632%   name as the Pengine.  The module is needed to
  633%
  634%   @arg Binding is a term binding(Vars,Term,Substitutions)
  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
  653%!  term_html_string(+Term, +VarNames, +Module, -HTMLString,
  654%!                   +Options) is det.
  655%
  656%   Translate  Term  into  an  HTML    string   using  the  operator
  657%   declarations from Module. VarNames is a   list of variable names
  658%   that have this value.
  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
  671%!  binding_term(+Term, +Vars, +WriteOptions)// is semidet.
  672%
  673%   Hook to render a Prolog result term as HTML. This hook is called
  674%   for each non-variable binding,  passing   the  binding  value as
  675%   Term, the names of the variables as   Vars and a list of options
  676%   for write_term/3.  If the hook fails, term//2 is called.
  677%
  678%   @arg    Vars is a list of variable names or `[]` if Term is a
  679%           _residual goal_.
  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
  696%!  subst_to_html(+Module, +Binding, -JSON) is det.
  697%
  698%   Render   a   variable   substitution     resulting   from   term
  699%   factorization, in this case breaking a cycle.
  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
  709%!  map_output(+ID, +Term, -JSON) is det.
  710%
  711%   Map an output term. This is the same for json-s and json-html.
  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)                % TBD: Check proper JSON object?
  728    ->  Data = Term
  729    ;   term_string(Term, Data)
  730    ).
  731
  732
  733%!  prolog_help:show_html_hook(+HTML)
  734%
  735%   Hook into help/1 to render the help output in the SWISH console.
  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                 /*******************************
  746                 *          SANDBOXING          *
  747                 *******************************/
  748
  749:- multifile
  750    sandbox:safe_primitive/1,       % Goal
  751    sandbox:safe_meta/2.            % Goal, Called
  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                 /*******************************
  778                 *         REDEFINITION         *
  779                 *******************************/
  780
  781%!  pengine_io_predicate(?Head)
  782%
  783%   True when Head describes the  head   of  a (system) IO predicate
  784%   that is redefined by the HTML binding.
  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                 /*******************************
  819                 *      REBIND PENGINE I/O      *
  820                 *******************************/
  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
  845%!  pengine_bind_user_streams
  846%
  847%   Bind the pengine user  I/O  streams   to  a  Prolog  stream that
  848%   redirects  the  input  and   output    to   pengine_input/2  and
  849%   pengine_output/1. This results in  less   pretty  behaviour then
  850%   redefining the I/O predicates to  produce   nice  HTML, but does
  851%   provide functioning I/O from included libraries.
  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
  876%!  pengine_output is semidet.
  877%!  pengine_input is semidet.
  878%
  879%   True when output (input) is redirected to a pengine.
  880
  881pengine_output :-
  882    current_output(Out),
  883    pengine_io(_, Out).
  884
  885pengine_input :-
  886    current_input(In),
  887    pengine_io(In, _).
  888
  889
  890%!  pengine_bind_io_to_html(+Module)
  891%
  892%   Redefine the built-in predicates for IO   to  send HTML messages
  893%   using pengine_output/1.
  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])