View source with formatted comments or as raw
    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-2019, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(pengines_io,
   37          [ pengine_writeln/1,          % +Term
   38            pengine_nl/0,
   39            pengine_tab/1,
   40            pengine_flush_output/0,
   41            pengine_format/1,           % +Format
   42            pengine_format/2,           % +Format, +Args
   43
   44            pengine_write_term/2,       % +Term, +Options
   45            pengine_write/1,            % +Term
   46            pengine_writeq/1,           % +Term
   47            pengine_display/1,          % +Term
   48            pengine_print/1,            % +Term
   49            pengine_write_canonical/1,  % +Term
   50
   51            pengine_listing/0,
   52            pengine_listing/1,          % +Spec
   53            pengine_portray_clause/1,   % +Term
   54
   55            pengine_read/1,             % -Term
   56            pengine_read_line_to_string/2, % +Stream, -LineAsString
   57            pengine_read_line_to_codes/2, % +Stream, -LineAsCodes
   58
   59            pengine_io_predicate/1,     % ?Head
   60            pengine_bind_io_to_html/1,  % +Module
   61            pengine_io_goal_expansion/2,% +Goal, -Expanded
   62
   63            message_lines_to_html/3     % +Lines, +Classes, -HTML
   64          ]).   65:- autoload(library(apply),[foldl/4,maplist/3,maplist/4]).   66:- autoload(library(backcomp),[thread_at_exit/1]).   67:- autoload(library(debug),[assertion/1]).   68:- autoload(library(error),[must_be/2]).   69:- autoload(library(listing),[listing/1,portray_clause/1]).   70:- autoload(library(lists),[append/2,append/3,subtract/3]).   71:- autoload(library(option),[option/3,merge_options/3]).   72:- autoload(library(pengines),
   73	    [ pengine_self/1,
   74	      pengine_output/1,
   75	      pengine_input/2,
   76	      pengine_property/2
   77	    ]).   78:- autoload(library(prolog_stream),[open_prolog_stream/4]).   79:- autoload(library(readutil),[read_line_to_string/2]).   80:- autoload(library(yall),[(>>)/4]).   81:- autoload(library(http/term_html),[term/4]).   82
   83:- use_module(library(http/html_write),[html/3,print_html/1, op(_,_,_)]).   84:- use_module(library(settings),[setting/4,setting/2]).   85
   86:- use_module(library(sandbox), []).   87:- autoload(library(thread), [call_in_thread/2]).   88
   89:- html_meta send_html(html).   90:- public send_html/1.   91
   92:- meta_predicate
   93    pengine_format(+,:).   94
   95/** <module> Provide Prolog I/O for HTML clients
   96
   97This module redefines some of  the   standard  Prolog  I/O predicates to
   98behave transparently for HTML clients. It  provides two ways to redefine
   99the standard predicates: using goal_expansion/2   and  by redefining the
  100system predicates using redefine_system_predicate/1. The   latter is the
  101preferred route because it gives a more   predictable  trace to the user
  102and works regardless of the use of other expansion and meta-calling.
  103
  104*Redefining* works by redefining the system predicates in the context of
  105the pengine's module. This  is  configured   using  the  following  code
  106snippet.
  107
  108  ==
  109  :- pengine_application(myapp).
  110  :- use_module(myapp:library(pengines_io)).
  111  pengines:prepare_module(Module, myapp, _Options) :-
  112        pengines_io:pengine_bind_io_to_html(Module).
  113  ==
  114
  115*Using goal_expansion/2* works by  rewriting   the  corresponding  goals
  116using goal_expansion/2 and use the new   definition  to re-route I/O via
  117pengine_input/2 and pengine_output/1. A pengine  application is prepared
  118for using this module with the following code:
  119
  120  ==
  121  :- pengine_application(myapp).
  122  :- use_module(myapp:library(pengines_io)).
  123  myapp:goal_expansion(In,Out) :-
  124        pengine_io_goal_expansion(In, Out).
  125  ==
  126*/
  127
  128:- setting(write_options, list(any), [max_depth(1000)],
  129           'Additional options for stringifying Prolog results').  130
  131
  132                 /*******************************
  133                 *            OUTPUT            *
  134                 *******************************/
  135
  136%!  pengine_writeln(+Term)
  137%
  138%   Emit Term as <span class=writeln>Term<br></span>.
  139
  140pengine_writeln(Term) :-
  141    pengine_output,
  142    !,
  143    pengine_module(Module),
  144    send_html(span(class(writeln),
  145                   [ \term(Term,
  146                           [ module(Module)
  147                           ]),
  148                     br([])
  149                   ])).
  150pengine_writeln(Term) :-
  151    writeln(Term).
  152
  153%!  pengine_nl
  154%
  155%   Emit a <br/> to the pengine.
  156
  157pengine_nl :-
  158    pengine_output,
  159    !,
  160    send_html(br([])).
  161pengine_nl :-
  162    nl.
  163
  164%!  pengine_tab(+N)
  165%
  166%   Emit N spaces
  167
  168pengine_tab(N) :-
  169    pengine_output,
  170    !,
  171    length(List, N),
  172    maplist(=(&(nbsp)), List),
  173    send_html(List).
  174pengine_tab(N) :-
  175    tab(N).
  176
  177
  178%!  pengine_flush_output
  179%
  180%   No-op.  Pengines do not use output buffering (maybe they should
  181%   though).
  182
  183pengine_flush_output :-
  184    pengine_output,
  185    !.
  186pengine_flush_output :-
  187    flush_output.
  188
  189%!  pengine_write_term(+Term, +Options)
  190%
  191%   Writes term as <span class=Class>Term</span>. In addition to the
  192%   options of write_term/2, these options are processed:
  193%
  194%     - class(+Class)
  195%       Specifies the class of the element.  Default is =write=.
  196
  197pengine_write_term(Term, Options) :-
  198    pengine_output,
  199    !,
  200    option(class(Class), Options, write),
  201    pengine_module(Module),
  202    send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
  203pengine_write_term(Term, Options) :-
  204    write_term(Term, Options).
  205
  206%!  pengine_write(+Term) is det.
  207%!  pengine_writeq(+Term) is det.
  208%!  pengine_display(+Term) is det.
  209%!  pengine_print(+Term) is det.
  210%!  pengine_write_canonical(+Term) is det.
  211%
  212%   Redirect the corresponding Prolog output predicates.
  213
  214pengine_write(Term) :-
  215    pengine_write_term(Term, [numbervars(true)]).
  216pengine_writeq(Term) :-
  217    pengine_write_term(Term, [quoted(true), numbervars(true)]).
  218pengine_display(Term) :-
  219    pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
  220pengine_print(Term) :-
  221    current_prolog_flag(print_write_options, Options),
  222    pengine_write_term(Term, Options).
  223pengine_write_canonical(Term) :-
  224    pengine_output,
  225    !,
  226    with_output_to(string(String), write_canonical(Term)),
  227    send_html(span(class([write, cononical]), String)).
  228pengine_write_canonical(Term) :-
  229    write_canonical(Term).
  230
  231%!  pengine_format(+Format) is det.
  232%!  pengine_format(+Format, +Args) is det.
  233%
  234%   As format/1,2. Emits a series  of   strings  with <br/> for each
  235%   newline encountered in the string.
  236%
  237%   @tbd: handle ~w, ~q, etc using term//2.  How can we do that??
  238
  239pengine_format(Format) :-
  240    pengine_format(Format, []).
  241pengine_format(Format, Args) :-
  242    pengine_output,
  243    !,
  244    format(string(String), Format, Args),
  245    split_string(String, "\n", "", Lines),
  246    send_html(\lines(Lines, format)).
  247pengine_format(Format, Args) :-
  248    format(Format, Args).
  249
  250
  251                 /*******************************
  252                 *            LISTING           *
  253                 *******************************/
  254
  255%!  pengine_listing is det.
  256%!  pengine_listing(+Spec) is det.
  257%
  258%   List the content of the current pengine or a specified predicate
  259%   in the pengine.
  260
  261pengine_listing :-
  262    pengine_listing(_).
  263
  264pengine_listing(Spec) :-
  265    pengine_self(Module),
  266    with_output_to(string(String), listing(Module:Spec)),
  267    split_string(String, "", "\n", [Pre]),
  268    send_html(pre(class(listing), Pre)).
  269
  270pengine_portray_clause(Term) :-
  271    pengine_output,
  272    !,
  273    with_output_to(string(String), portray_clause(Term)),
  274    split_string(String, "", "\n", [Pre]),
  275    send_html(pre(class(listing), Pre)).
  276pengine_portray_clause(Term) :-
  277    portray_clause(Term).
  278
  279
  280                 /*******************************
  281                 *         PRINT MESSAGE        *
  282                 *******************************/
  283
  284:- multifile user:message_hook/3.  285
  286%!  user:message_hook(+Term, +Kind, +Lines) is semidet.
  287%
  288%   Send output from print_message/2 to   the  pengine. Messages are
  289%   embedded in a <pre class=msg-Kind></pre> environment.
  290
  291user:message_hook(Term, Kind, Lines) :-
  292    Kind \== silent,
  293    pengine_self(_),
  294    atom_concat('msg-', Kind, Class),
  295    message_lines_to_html(Lines, [Class], HTMlString),
  296    (   source_location(File, Line)
  297    ->  Src = File:Line
  298    ;   Src = (-)
  299    ),
  300    pengine_output(message(Term, Kind, HTMlString, Src)).
  301
  302%!  message_lines_to_html(+MessageLines, +Classes, -HTMLString) is det.
  303%
  304%   Helper that translates the `Lines` argument from user:message_hook/3
  305%   into an HTML string. The  HTML  is   a  <pre>  object with the class
  306%   `'prolog-message'` and the given Classes.
  307
  308message_lines_to_html(Lines, Classes, HTMlString) :-
  309    phrase(html(pre(class(['prolog-message'|Classes]),
  310                    \message_lines(Lines))), Tokens),
  311    with_output_to(string(HTMlString), print_html(Tokens)).
  312
  313message_lines([]) -->
  314    !.
  315message_lines([nl|T]) -->
  316    !,
  317    html('\n'),                     % we are in a <pre> environment
  318    message_lines(T).
  319message_lines([flush]) -->
  320    !.
  321message_lines([ansi(Attributes, Fmt, Args)|T]) -->
  322    !,
  323    {  is_list(Attributes)
  324    -> foldl(style, Attributes, Fmt-Args, HTML)
  325    ;  style(Attributes, Fmt-Args, HTML)
  326    },
  327    html(HTML),
  328    message_lines(T).
  329message_lines([H|T]) -->
  330    html(H),
  331    message_lines(T).
  332
  333style(bold, Content, b(Content)) :- !.
  334style(fg(default), Content, span(style('color: black'), Content)) :- !.
  335style(fg(Color), Content, span(style('color:'+Color), Content)) :- !.
  336style(_, Content, Content).
  337
  338
  339                 /*******************************
  340                 *             INPUT            *
  341                 *******************************/
  342
  343pengine_read(Term) :-
  344    pengine_input,
  345    !,
  346    prompt(Prompt, Prompt),
  347    pengine_input(Prompt, Term).
  348pengine_read(Term) :-
  349    read(Term).
  350
  351pengine_read_line_to_string(From, String) :-
  352    pengine_input,
  353    !,
  354    must_be(oneof([current_input,user_input]), From),
  355    (   prompt(Prompt, Prompt),
  356        Prompt \== ''
  357    ->  true
  358    ;   Prompt = 'line> '
  359    ),
  360    pengine_input(_{type: console, prompt:Prompt}, StringNL),
  361    string_concat(String, "\n", StringNL).
  362pengine_read_line_to_string(From, String) :-
  363    read_line_to_string(From, String).
  364
  365pengine_read_line_to_codes(From, Codes) :-
  366    pengine_read_line_to_string(From, String),
  367    string_codes(String, Codes).
  368
  369
  370                 /*******************************
  371                 *             HTML             *
  372                 *******************************/
  373
  374lines([], _) --> [].
  375lines([H|T], Class) -->
  376    html(span(class(Class), H)),
  377    (   { T == [] }
  378    ->  []
  379    ;   html(br([])),
  380        lines(T, Class)
  381    ).
  382
  383%!  send_html(+HTML) is det.
  384%
  385%   Convert html//1 term into a string and send it to the client
  386%   using pengine_output/1.
  387
  388send_html(HTML) :-
  389    phrase(html(HTML), Tokens),
  390    with_output_to(string(HTMlString), print_html(Tokens)),
  391    pengine_output(HTMlString).
  392
  393
  394%!  pengine_module(-Module) is det.
  395%
  396%   Module (used for resolving operators).
  397
  398pengine_module(Module) :-
  399    pengine_self(Pengine),
  400    !,
  401    pengine_property(Pengine, module(Module)).
  402pengine_module(user).
  403
  404                 /*******************************
  405                 *        OUTPUT FORMAT         *
  406                 *******************************/
  407
  408%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames) is semidet.
  409%
  410%   Provide additional translations for  Prolog   terms  to  output.
  411%   Defines formats are:
  412%
  413%     * 'json-s'
  414%     _Simple_ or _string_ format: Prolog terms are sent using
  415%     quoted write.
  416%     * 'json-html'
  417%     Serialize responses as HTML string.  This is intended for
  418%     applications that emulate the Prolog toplevel.  This format
  419%     carries the following data:
  420%
  421%       - data
  422%         List if answers, where each answer is an object with
  423%         - variables
  424%           Array of objects, each describing a variable.  These
  425%           objects contain these fields:
  426%           - variables: Array of strings holding variable names
  427%           - value: HTML-ified value of the variables
  428%           - substitutions: Array of objects for substitutions
  429%             that break cycles holding:
  430%             - var: Name of the inserted variable
  431%             - value: HTML-ified value
  432%         - residuals
  433%           Array of strings representing HTML-ified residual goals.
  434
  435:- multifile
  436    pengines:event_to_json/3.  437
  438%!  pengines:event_to_json(+PrologEvent, -JSONEvent, +Format, +VarNames)
  439%
  440%   If Format equals `'json-s'` or  `'json-html'`, emit a simplified
  441%   JSON representation of the  data,   suitable  for notably SWISH.
  442%   This deals with Prolog answers and output messages. If a message
  443%   originates from print_message/3,  it   gets  several  additional
  444%   properties:
  445%
  446%     - message:Kind
  447%       Indicate the _kind_ of the message (=error=, =warning=,
  448%       etc.)
  449%     - location:_{file:File, line:Line, ch:CharPos}
  450%       If the message is related to a source location, indicate the
  451%       file and line and, if available, the character location.
  452
  453pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
  454                       'json-s') :-
  455    !,
  456    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  457    maplist(answer_to_json_strings(ID), Answers0, Answers),
  458    add_projection(Projection, JSON0, JSON).
  459pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
  460    !,
  461    map_output(ID, Term, JSON).
  462
  463add_projection([], JSON, JSON) :- !.
  464add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
  465
  466
  467%!  answer_to_json_strings(+Pengine, +AnswerDictIn, -AnswerDict).
  468%
  469%   Translate answer dict with Prolog term   values into answer dict
  470%   with string values.
  471
  472answer_to_json_strings(Pengine, DictIn, DictOut) :-
  473    dict_pairs(DictIn, Tag, Pairs),
  474    maplist(term_string_value(Pengine), Pairs, BindingsOut),
  475    dict_pairs(DictOut, Tag, BindingsOut).
  476
  477term_string_value(Pengine, N-V, N-A) :-
  478    with_output_to(string(A),
  479                   write_term(V,
  480                              [ module(Pengine),
  481                                quoted(true)
  482                              ])).
  483
  484%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames)
  485%
  486%   Implement translation of a Pengine event to =json-html= format. This
  487%   format represents the answer as JSON,  but the variable bindings are
  488%   (structured) HTML strings rather than JSON objects.
  489%
  490%   CHR residual goals are not  bound   to  the projection variables. We
  491%   hacked a bypass to fetch these by returning them in a variable named
  492%   `_residuals`, which must be bound to a term '$residuals'(List). Such
  493%   a variable is removed from  the   projection  and  added to residual
  494%   goals.
  495
  496pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
  497                       JSON, 'json-html') :-
  498    !,
  499    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  500    maplist(map_answer(ID), Answers0, ResVars, Answers),
  501    add_projection(Projection, ResVars, JSON0, JSON).
  502pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
  503    !,
  504    map_output(ID, Term, JSON).
  505
  506map_answer(ID, Bindings0, ResVars, Answer) :-
  507    dict_bindings(Bindings0, Bindings1),
  508    select_residuals(Bindings1, Bindings2, ResVars, Residuals0, Clauses),
  509    append(Residuals0, Residuals1),
  510    prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
  511                              ID:Residuals-_HiddenResiduals),
  512    maplist(binding_to_html(ID), Bindings3, VarBindings),
  513    final_answer(ID, VarBindings, Residuals, Clauses, Answer).
  514
  515final_answer(_Id, VarBindings, [], [], Answer) :-
  516    !,
  517    Answer = json{variables:VarBindings}.
  518final_answer(ID, VarBindings, Residuals, [], Answer) :-
  519    !,
  520    residuals_html(Residuals, ID, ResHTML),
  521    Answer = json{variables:VarBindings, residuals:ResHTML}.
  522final_answer(ID, VarBindings, [], Clauses, Answer) :-
  523    !,
  524    clauses_html(Clauses, ID, ClausesHTML),
  525    Answer = json{variables:VarBindings, wfs_residual_program:ClausesHTML}.
  526final_answer(ID, VarBindings, Residuals, Clauses, Answer) :-
  527    !,
  528    residuals_html(Residuals, ID, ResHTML),
  529    clauses_html(Clauses, ID, ClausesHTML),
  530    Answer = json{variables:VarBindings,
  531                  residuals:ResHTML,
  532                  wfs_residual_program:ClausesHTML}.
  533
  534residuals_html([], _, []).
  535residuals_html([H0|T0], Module, [H|T]) :-
  536    term_html_string(H0, [], Module, H, [priority(999)]),
  537    residuals_html(T0, Module, T).
  538
  539clauses_html(Clauses, _ID, HTMLString) :-
  540    with_output_to(string(Program), list_clauses(Clauses)),
  541    phrase(html(pre([class('wfs-residual-program')], Program)), Tokens),
  542    with_output_to(string(HTMLString), print_html(Tokens)).
  543
  544list_clauses([]).
  545list_clauses([H|T]) :-
  546    (   system_undefined(H)
  547    ->  true
  548    ;   portray_clause(H)
  549    ),
  550    list_clauses(T).
  551
  552system_undefined((undefined :- tnot(undefined))).
  553system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
  554system_undefined((radial_restraint :- tnot(radial_restraint))).
  555
  556dict_bindings(Dict, Bindings) :-
  557    dict_pairs(Dict, _Tag, Pairs),
  558    maplist([N-V,N=V]>>true, Pairs, Bindings).
  559
  560select_residuals([], [], [], [], []).
  561select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  562    binding_residual(H, Var, Residual),
  563    !,
  564    Vars = [Var|TV],
  565    Residuals = [Residual|TR],
  566    select_residuals(T, Bindings, TV, TR, Clauses).
  567select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  568    binding_residual_clauses(H, Var, Delays, Clauses0),
  569    !,
  570    Vars = [Var|TV],
  571    Residuals = [Delays|TR],
  572    append(Clauses0, CT, Clauses),
  573    select_residuals(T, Bindings, TV, TR, CT).
  574select_residuals([H|T0], [H|T], Vars, Residuals, Clauses) :-
  575    select_residuals(T0, T, Vars, Residuals, Clauses).
  576
  577binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
  578    is_list(Residuals).
  579binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
  580    is_list(Residuals).
  581binding_residual('Residual'  = '$residual'(Residual),   'Residual', [Residual]) :-
  582    callable(Residual).
  583
  584binding_residual_clauses(
  585    '_wfs_residual_program' = '$wfs_residual_program'(Delays, Clauses),
  586    '_wfs_residual_program', Residuals, Clauses) :-
  587    phrase(comma_list(Delays), Residuals).
  588
  589comma_list(true) --> !.
  590comma_list((A,B)) --> !, comma_list(A), comma_list(B).
  591comma_list(A) --> [A].
  592
  593add_projection(-, _, JSON, JSON) :- !.
  594add_projection(VarNames0, ResVars0, JSON0, JSON) :-
  595    append(ResVars0, ResVars1),
  596    sort(ResVars1, ResVars),
  597    subtract(VarNames0, ResVars, VarNames),
  598    add_projection(VarNames, JSON0, JSON).
  599
  600
  601%!  binding_to_html(+Pengine, +Binding, -Dict) is det.
  602%
  603%   Convert a variable binding into a JSON Dict. Note that this code
  604%   assumes that the module associated  with   Pengine  has the same
  605%   name as the Pengine.  The module is needed to
  606%
  607%   @arg Binding is a term binding(Vars,Term,Substitutions)
  608
  609binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
  610    JSON0 = json{variables:Vars, value:HTMLString},
  611    binding_write_options(ID, Options),
  612    term_html_string(Term, Vars, ID, HTMLString, Options),
  613    (   Substitutions == []
  614    ->  JSON = JSON0
  615    ;   maplist(subst_to_html(ID), Substitutions, HTMLSubst),
  616        JSON = JSON0.put(substitutions, HTMLSubst)
  617    ).
  618
  619binding_write_options(Pengine, Options) :-
  620    (   current_predicate(Pengine:screen_property/1),
  621        Pengine:screen_property(tabled(true))
  622    ->  Options = []
  623    ;   Options = [priority(699)]
  624    ).
  625
  626%!  term_html_string(+Term, +VarNames, +Module, -HTMLString,
  627%!                   +Options) is det.
  628%
  629%   Translate  Term  into  an  HTML    string   using  the  operator
  630%   declarations from Module. VarNames is a   list of variable names
  631%   that have this value.
  632
  633term_html_string(Term, Vars, Module, HTMLString, Options) :-
  634    setting(write_options, WOptions),
  635    merge_options(WOptions,
  636                  [ quoted(true),
  637                    numbervars(true),
  638                    module(Module)
  639                  | Options
  640                  ], WriteOptions),
  641    phrase(term_html(Term, Vars, WriteOptions), Tokens),
  642    with_output_to(string(HTMLString), print_html(Tokens)).
  643
  644%!  binding_term(+Term, +Vars, +WriteOptions)// is semidet.
  645%
  646%   Hook to render a Prolog result term as HTML. This hook is called
  647%   for each non-variable binding,  passing   the  binding  value as
  648%   Term, the names of the variables as   Vars and a list of options
  649%   for write_term/3.  If the hook fails, term//2 is called.
  650%
  651%   @arg    Vars is a list of variable names or `[]` if Term is a
  652%           _residual goal_.
  653
  654:- multifile binding_term//3.  655
  656term_html(Term, Vars, WriteOptions) -->
  657    { nonvar(Term) },
  658    binding_term(Term, Vars, WriteOptions),
  659    !.
  660term_html(Term, _Vars, WriteOptions) -->
  661    term(Term, WriteOptions).
  662
  663%!  subst_to_html(+Module, +Binding, -JSON) is det.
  664%
  665%   Render   a   variable   substitution     resulting   from   term
  666%   factorization, in this case breaking a cycle.
  667
  668subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
  669    !,
  670    binding_write_options(ID, Options),
  671    term_html_string(Value, [Name], ID, HTMLString, Options).
  672subst_to_html(_, Term, _) :-
  673    assertion(Term = '$VAR'(_)).
  674
  675
  676%!  map_output(+ID, +Term, -JSON) is det.
  677%
  678%   Map an output term. This is the same for json-s and json-html.
  679
  680map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
  681    atomic(HTMLString),
  682    !,
  683    JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
  684    pengines:add_error_details(Term, JSON0, JSON1),
  685    (   Src = File:Line,
  686        \+ JSON1.get(location) = _
  687    ->  JSON = JSON1.put(_{location:_{file:File, line:Line}})
  688    ;   JSON = JSON1
  689    ).
  690map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
  691    (   atomic(Term)
  692    ->  Data = Term
  693    ;   is_dict(Term, json),
  694        ground(json)                % TBD: Check proper JSON object?
  695    ->  Data = Term
  696    ;   term_string(Term, Data)
  697    ).
  698
  699
  700%!  prolog_help:show_html_hook(+HTML)
  701%
  702%   Hook into help/1 to render the help output in the SWISH console.
  703
  704:- multifile
  705    prolog_help:show_html_hook/1.  706
  707prolog_help:show_html_hook(HTML) :-
  708    pengine_output,
  709    pengine_output(HTML).
  710
  711
  712                 /*******************************
  713                 *          SANDBOXING          *
  714                 *******************************/
  715
  716:- multifile
  717    sandbox:safe_primitive/1,       % Goal
  718    sandbox:safe_meta/2.            % Goal, Called
  719
  720sandbox:safe_primitive(pengines_io:pengine_listing(_)).
  721sandbox:safe_primitive(pengines_io:pengine_nl).
  722sandbox:safe_primitive(pengines_io:pengine_tab(_)).
  723sandbox:safe_primitive(pengines_io:pengine_flush_output).
  724sandbox:safe_primitive(pengines_io:pengine_print(_)).
  725sandbox:safe_primitive(pengines_io:pengine_write(_)).
  726sandbox:safe_primitive(pengines_io:pengine_read(_)).
  727sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)).
  728sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)).
  729sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
  730sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
  731sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
  732sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
  733sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
  734sandbox:safe_primitive(system:write_term(_,_)).
  735sandbox:safe_primitive(system:prompt(_,_)).
  736sandbox:safe_primitive(system:statistics(_,_)).
  737
  738sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
  739    sandbox:format_calls(Format, Args, Calls).
  740
  741
  742                 /*******************************
  743                 *         REDEFINITION         *
  744                 *******************************/
  745
  746%!  pengine_io_predicate(?Head)
  747%
  748%   True when Head describes the  head   of  a (system) IO predicate
  749%   that is redefined by the HTML binding.
  750
  751pengine_io_predicate(writeln(_)).
  752pengine_io_predicate(nl).
  753pengine_io_predicate(tab(_)).
  754pengine_io_predicate(flush_output).
  755pengine_io_predicate(format(_)).
  756pengine_io_predicate(format(_,_)).
  757pengine_io_predicate(read(_)).
  758pengine_io_predicate(read_line_to_string(_,_)).
  759pengine_io_predicate(read_line_to_codes(_,_)).
  760pengine_io_predicate(write_term(_,_)).
  761pengine_io_predicate(write(_)).
  762pengine_io_predicate(writeq(_)).
  763pengine_io_predicate(display(_)).
  764pengine_io_predicate(print(_)).
  765pengine_io_predicate(write_canonical(_)).
  766pengine_io_predicate(listing).
  767pengine_io_predicate(listing(_)).
  768pengine_io_predicate(portray_clause(_)).
  769
  770term_expansion(pengine_io_goal_expansion(_,_),
  771               Clauses) :-
  772    findall(Clause, io_mapping(Clause), Clauses).
  773
  774io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
  775    pengine_io_predicate(Head),
  776    Head =.. [Name|Args],
  777    atom_concat(pengine_, Name, BodyName),
  778    Mapped =.. [BodyName|Args].
  779
  780pengine_io_goal_expansion(_, _).
  781
  782
  783                 /*******************************
  784                 *      REBIND PENGINE I/O      *
  785                 *******************************/
  786
  787:- public
  788    stream_write/2,
  789    stream_read/2,
  790    stream_close/1.  791
  792:- thread_local
  793    pengine_io/2.  794
  795stream_write(Stream, Out) :-
  796    (   pengine_io(_,_)
  797    ->  send_html(pre(class(console), Out))
  798    ;   current_prolog_flag(pengine_main_thread, TID),
  799        thread_signal(TID, stream_write(Stream, Out))
  800    ).
  801stream_read(Stream, Data) :-
  802    (   pengine_io(_,_)
  803    ->  prompt(Prompt, Prompt),
  804        pengine_input(_{type:console, prompt:Prompt}, Data)
  805    ;   current_prolog_flag(pengine_main_thread, TID),
  806        call_in_thread(TID, stream_read(Stream, Data))
  807    ).
  808stream_close(_Stream).
  809
  810%!  pengine_bind_user_streams
  811%
  812%   Bind the pengine user  I/O  streams   to  a  Prolog  stream that
  813%   redirects  the  input  and   output    to   pengine_input/2  and
  814%   pengine_output/1. This results in  less   pretty  behaviour then
  815%   redefining the I/O predicates to  produce   nice  HTML, but does
  816%   provide functioning I/O from included libraries.
  817
  818pengine_bind_user_streams :-
  819    Err = Out,
  820    open_prolog_stream(pengines_io, write, Out, []),
  821    set_stream(Out, buffer(line)),
  822    open_prolog_stream(pengines_io, read,  In, []),
  823    set_stream(In,  alias(user_input)),
  824    set_stream(Out, alias(user_output)),
  825    set_stream(Err, alias(user_error)),
  826    set_stream(In,  alias(current_input)),
  827    set_stream(Out, alias(current_output)),
  828    assertz(pengine_io(In, Out)),
  829    thread_self(Me),
  830    thread_property(Me, id(Id)),
  831    set_prolog_flag(pengine_main_thread, Id),
  832    thread_at_exit(close_io).
  833
  834close_io :-
  835    retract(pengine_io(In, Out)),
  836    !,
  837    close(In, [force(true)]),
  838    close(Out, [force(true)]).
  839close_io.
  840
  841%!  pengine_output is semidet.
  842%!  pengine_input is semidet.
  843%
  844%   True when output (input) is redirected to a pengine.
  845
  846pengine_output :-
  847    current_output(Out),
  848    pengine_io(_, Out).
  849
  850pengine_input :-
  851    current_input(In),
  852    pengine_io(In, _).
  853
  854
  855%!  pengine_bind_io_to_html(+Module)
  856%
  857%   Redefine the built-in predicates for IO   to  send HTML messages
  858%   using pengine_output/1.
  859
  860pengine_bind_io_to_html(Module) :-
  861    forall(pengine_io_predicate(Head),
  862           bind_io(Head, Module)),
  863    pengine_bind_user_streams.
  864
  865bind_io(Head, Module) :-
  866    prompt(_, ''),
  867    redefine_system_predicate(Module:Head),
  868    functor(Head, Name, Arity),
  869    Head =.. [Name|Args],
  870    atom_concat(pengine_, Name, BodyName),
  871    Body =.. [BodyName|Args],
  872    assertz(Module:(Head :- Body)),
  873    compile_predicates([Module:Name/Arity])