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(Expr) :-
  169    pengine_output,
  170    !,
  171    N is Expr,
  172    length(List, N),
  173    maplist(=(&(nbsp)), List),
  174    send_html(List).
  175pengine_tab(N) :-
  176    tab(N).
  177
  178
  179%!  pengine_flush_output
  180%
  181%   No-op.  Pengines do not use output buffering (maybe they should
  182%   though).
  183
  184pengine_flush_output :-
  185    pengine_output,
  186    !.
  187pengine_flush_output :-
  188    flush_output.
  189
  190%!  pengine_write_term(+Term, +Options)
  191%
  192%   Writes term as <span class=Class>Term</span>. In addition to the
  193%   options of write_term/2, these options are processed:
  194%
  195%     - class(+Class)
  196%       Specifies the class of the element.  Default is =write=.
  197
  198pengine_write_term(Term, Options) :-
  199    pengine_output,
  200    !,
  201    option(class(Class), Options, write),
  202    pengine_module(Module),
  203    send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
  204pengine_write_term(Term, Options) :-
  205    write_term(Term, Options).
  206
  207%!  pengine_write(+Term) is det.
  208%!  pengine_writeq(+Term) is det.
  209%!  pengine_display(+Term) is det.
  210%!  pengine_print(+Term) is det.
  211%!  pengine_write_canonical(+Term) is det.
  212%
  213%   Redirect the corresponding Prolog output predicates.
  214
  215pengine_write(Term) :-
  216    pengine_write_term(Term, [numbervars(true)]).
  217pengine_writeq(Term) :-
  218    pengine_write_term(Term, [quoted(true), numbervars(true)]).
  219pengine_display(Term) :-
  220    pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
  221pengine_print(Term) :-
  222    current_prolog_flag(print_write_options, Options),
  223    pengine_write_term(Term, Options).
  224pengine_write_canonical(Term) :-
  225    pengine_output,
  226    !,
  227    with_output_to(string(String), write_canonical(Term)),
  228    send_html(span(class([write, cononical]), String)).
  229pengine_write_canonical(Term) :-
  230    write_canonical(Term).
  231
  232%!  pengine_format(+Format) is det.
  233%!  pengine_format(+Format, +Args) is det.
  234%
  235%   As format/1,2. Emits a series  of   strings  with <br/> for each
  236%   newline encountered in the string.
  237%
  238%   @tbd: handle ~w, ~q, etc using term//2.  How can we do that??
  239
  240pengine_format(Format) :-
  241    pengine_format(Format, []).
  242pengine_format(Format, Args) :-
  243    pengine_output,
  244    !,
  245    format(string(String), Format, Args),
  246    split_string(String, "\n", "", Lines),
  247    send_html(\lines(Lines, format)).
  248pengine_format(Format, Args) :-
  249    format(Format, Args).
  250
  251
  252                 /*******************************
  253                 *            LISTING           *
  254                 *******************************/
  255
  256%!  pengine_listing is det.
  257%!  pengine_listing(+Spec) is det.
  258%
  259%   List the content of the current pengine or a specified predicate
  260%   in the pengine.
  261
  262pengine_listing :-
  263    pengine_listing(_).
  264
  265pengine_listing(Spec) :-
  266    pengine_self(Module),
  267    with_output_to(string(String), listing(Module:Spec)),
  268    split_string(String, "", "\n", [Pre]),
  269    send_html(pre(class(listing), Pre)).
  270
  271pengine_portray_clause(Term) :-
  272    pengine_output,
  273    !,
  274    with_output_to(string(String), portray_clause(Term)),
  275    split_string(String, "", "\n", [Pre]),
  276    send_html(pre(class(listing), Pre)).
  277pengine_portray_clause(Term) :-
  278    portray_clause(Term).
  279
  280
  281                 /*******************************
  282                 *         PRINT MESSAGE        *
  283                 *******************************/
  284
  285:- multifile user:message_hook/3.  286
  287%!  user:message_hook(+Term, +Kind, +Lines) is semidet.
  288%
  289%   Send output from print_message/2 to   the  pengine. Messages are
  290%   embedded in a <pre class=msg-Kind></pre> environment.
  291
  292user:message_hook(Term, Kind, Lines) :-
  293    Kind \== silent,
  294    pengine_self(_),
  295    atom_concat('msg-', Kind, Class),
  296    message_lines_to_html(Lines, [Class], HTMlString),
  297    (   source_location(File, Line)
  298    ->  Src = File:Line
  299    ;   Src = (-)
  300    ),
  301    pengine_output(message(Term, Kind, HTMlString, Src)).
  302
  303%!  message_lines_to_html(+MessageLines, +Classes, -HTMLString) is det.
  304%
  305%   Helper that translates the `Lines` argument from user:message_hook/3
  306%   into an HTML string. The  HTML  is   a  <pre>  object with the class
  307%   `'prolog-message'` and the given Classes.
  308
  309message_lines_to_html(Lines, Classes, HTMlString) :-
  310    phrase(html(pre(class(['prolog-message'|Classes]),
  311                    \message_lines(Lines))), Tokens),
  312    with_output_to(string(HTMlString), print_html(Tokens)).
  313
  314message_lines([]) -->
  315    !.
  316message_lines([nl|T]) -->
  317    !,
  318    html('\n'),                     % we are in a <pre> environment
  319    message_lines(T).
  320message_lines([flush]) -->
  321    !.
  322message_lines([ansi(Attributes, Fmt, Args)|T]) -->
  323    !,
  324    {  is_list(Attributes)
  325    -> foldl(style, Attributes, Fmt-Args, HTML)
  326    ;  style(Attributes, Fmt-Args, HTML)
  327    },
  328    html(HTML),
  329    message_lines(T).
  330message_lines([url(Pos)|T]) -->
  331    !,
  332    location(Pos),
  333    message_lines(T).
  334message_lines([url(HREF, Label)|T]) -->
  335    !,
  336    html(a(href(HREF),Label)),
  337    message_lines(T).
  338message_lines([H|T]) -->
  339    html(H),
  340    message_lines(T).
  341
  342location(File:Line:Column) -->
  343    !,
  344    html([File, :, Line, :, Column]).
  345location(File:Line) -->
  346    !,
  347    html([File, :, Line]).
  348location(File) -->
  349    html([File]).
  350
  351style(bold, Content, b(Content)) :- !.
  352style(fg(default), Content, span(style('color: black'), Content)) :- !.
  353style(fg(Color), Content, span(style('color:'+Color), Content)) :- !.
  354style(_, Content, Content).
  355
  356
  357                 /*******************************
  358                 *             INPUT            *
  359                 *******************************/
  360
  361pengine_read(Term) :-
  362    pengine_input,
  363    !,
  364    prompt(Prompt, Prompt),
  365    pengine_input(Prompt, Term).
  366pengine_read(Term) :-
  367    read(Term).
  368
  369pengine_read_line_to_string(From, String) :-
  370    pengine_input,
  371    !,
  372    must_be(oneof([current_input,user_input]), From),
  373    (   prompt(Prompt, Prompt),
  374        Prompt \== ''
  375    ->  true
  376    ;   Prompt = 'line> '
  377    ),
  378    pengine_input(_{type: console, prompt:Prompt}, StringNL),
  379    string_concat(String, "\n", StringNL).
  380pengine_read_line_to_string(From, String) :-
  381    read_line_to_string(From, String).
  382
  383pengine_read_line_to_codes(From, Codes) :-
  384    pengine_read_line_to_string(From, String),
  385    string_codes(String, Codes).
  386
  387
  388                 /*******************************
  389                 *             HTML             *
  390                 *******************************/
  391
  392lines([], _) --> [].
  393lines([H|T], Class) -->
  394    html(span(class(Class), H)),
  395    (   { T == [] }
  396    ->  []
  397    ;   html(br([])),
  398        lines(T, Class)
  399    ).
  400
  401%!  send_html(+HTML) is det.
  402%
  403%   Convert html//1 term into a string and send it to the client
  404%   using pengine_output/1.
  405
  406send_html(HTML) :-
  407    phrase(html(HTML), Tokens),
  408    with_output_to(string(HTMlString), print_html(Tokens)),
  409    pengine_output(HTMlString).
  410
  411
  412%!  pengine_module(-Module) is det.
  413%
  414%   Module (used for resolving operators).
  415
  416pengine_module(Module) :-
  417    pengine_self(Pengine),
  418    !,
  419    pengine_property(Pengine, module(Module)).
  420pengine_module(user).
  421
  422                 /*******************************
  423                 *        OUTPUT FORMAT         *
  424                 *******************************/
  425
  426%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames) is semidet.
  427%
  428%   Provide additional translations for  Prolog   terms  to  output.
  429%   Defines formats are:
  430%
  431%     * 'json-s'
  432%     _Simple_ or _string_ format: Prolog terms are sent using
  433%     quoted write.
  434%     * 'json-html'
  435%     Serialize responses as HTML string.  This is intended for
  436%     applications that emulate the Prolog toplevel.  This format
  437%     carries the following data:
  438%
  439%       - data
  440%         List if answers, where each answer is an object with
  441%         - variables
  442%           Array of objects, each describing a variable.  These
  443%           objects contain these fields:
  444%           - variables: Array of strings holding variable names
  445%           - value: HTML-ified value of the variables
  446%           - substitutions: Array of objects for substitutions
  447%             that break cycles holding:
  448%             - var: Name of the inserted variable
  449%             - value: HTML-ified value
  450%         - residuals
  451%           Array of strings representing HTML-ified residual goals.
  452
  453:- multifile
  454    pengines:event_to_json/3.  455
  456%!  pengines:event_to_json(+PrologEvent, -JSONEvent, +Format, +VarNames)
  457%
  458%   If Format equals `'json-s'` or  `'json-html'`, emit a simplified
  459%   JSON representation of the  data,   suitable  for notably SWISH.
  460%   This deals with Prolog answers and output messages. If a message
  461%   originates from print_message/3,  it   gets  several  additional
  462%   properties:
  463%
  464%     - message:Kind
  465%       Indicate the _kind_ of the message (=error=, =warning=,
  466%       etc.)
  467%     - location:_{file:File, line:Line, ch:CharPos}
  468%       If the message is related to a source location, indicate the
  469%       file and line and, if available, the character location.
  470
  471pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
  472                       'json-s') :-
  473    !,
  474    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  475    maplist(answer_to_json_strings(ID), Answers0, Answers),
  476    add_projection(Projection, JSON0, JSON).
  477pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
  478    !,
  479    map_output(ID, Term, JSON).
  480
  481add_projection([], JSON, JSON) :- !.
  482add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
  483
  484
  485%!  answer_to_json_strings(+Pengine, +AnswerDictIn, -AnswerDict).
  486%
  487%   Translate answer dict with Prolog term   values into answer dict
  488%   with string values.
  489
  490answer_to_json_strings(Pengine, DictIn, DictOut) :-
  491    dict_pairs(DictIn, Tag, Pairs),
  492    maplist(term_string_value(Pengine), Pairs, BindingsOut),
  493    dict_pairs(DictOut, Tag, BindingsOut).
  494
  495term_string_value(Pengine, N-V, N-A) :-
  496    with_output_to(string(A),
  497                   write_term(V,
  498                              [ module(Pengine),
  499                                quoted(true)
  500                              ])).
  501
  502%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames)
  503%
  504%   Implement translation of a Pengine event to =json-html= format. This
  505%   format represents the answer as JSON,  but the variable bindings are
  506%   (structured) HTML strings rather than JSON objects.
  507%
  508%   CHR residual goals are not  bound   to  the projection variables. We
  509%   hacked a bypass to fetch these by returning them in a variable named
  510%   `_residuals`, which must be bound to a term '$residuals'(List). Such
  511%   a variable is removed from  the   projection  and  added to residual
  512%   goals.
  513
  514pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
  515                       JSON, 'json-html') :-
  516    !,
  517    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  518    maplist(map_answer(ID), Answers0, ResVars, Answers),
  519    add_projection(Projection, ResVars, JSON0, JSON).
  520pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
  521    !,
  522    map_output(ID, Term, JSON).
  523
  524map_answer(ID, Bindings0, ResVars, Answer) :-
  525    dict_bindings(Bindings0, Bindings1),
  526    select_residuals(Bindings1, Bindings2, ResVars, Residuals0, Clauses),
  527    append(Residuals0, Residuals1),
  528    prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
  529                              ID:Residuals-_HiddenResiduals),
  530    maplist(binding_to_html(ID), Bindings3, VarBindings),
  531    final_answer(ID, VarBindings, Residuals, Clauses, Answer).
  532
  533final_answer(_Id, VarBindings, [], [], Answer) :-
  534    !,
  535    Answer = json{variables:VarBindings}.
  536final_answer(ID, VarBindings, Residuals, [], Answer) :-
  537    !,
  538    residuals_html(Residuals, ID, ResHTML),
  539    Answer = json{variables:VarBindings, residuals:ResHTML}.
  540final_answer(ID, VarBindings, [], Clauses, Answer) :-
  541    !,
  542    clauses_html(Clauses, ID, ClausesHTML),
  543    Answer = json{variables:VarBindings, wfs_residual_program:ClausesHTML}.
  544final_answer(ID, VarBindings, Residuals, Clauses, Answer) :-
  545    !,
  546    residuals_html(Residuals, ID, ResHTML),
  547    clauses_html(Clauses, ID, ClausesHTML),
  548    Answer = json{variables:VarBindings,
  549                  residuals:ResHTML,
  550                  wfs_residual_program:ClausesHTML}.
  551
  552residuals_html([], _, []).
  553residuals_html([H0|T0], Module, [H|T]) :-
  554    term_html_string(H0, [], Module, H, [priority(999)]),
  555    residuals_html(T0, Module, T).
  556
  557clauses_html(Clauses, _ID, HTMLString) :-
  558    with_output_to(string(Program), list_clauses(Clauses)),
  559    phrase(html(pre([class('wfs-residual-program')], Program)), Tokens),
  560    with_output_to(string(HTMLString), print_html(Tokens)).
  561
  562list_clauses([]).
  563list_clauses([H|T]) :-
  564    (   system_undefined(H)
  565    ->  true
  566    ;   portray_clause(H)
  567    ),
  568    list_clauses(T).
  569
  570system_undefined((undefined :- tnot(undefined))).
  571system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
  572system_undefined((radial_restraint :- tnot(radial_restraint))).
  573
  574dict_bindings(Dict, Bindings) :-
  575    dict_pairs(Dict, _Tag, Pairs),
  576    maplist([N-V,N=V]>>true, Pairs, Bindings).
  577
  578select_residuals([], [], [], [], []).
  579select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  580    binding_residual(H, Var, Residual),
  581    !,
  582    Vars = [Var|TV],
  583    Residuals = [Residual|TR],
  584    select_residuals(T, Bindings, TV, TR, Clauses).
  585select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  586    binding_residual_clauses(H, Var, Delays, Clauses0),
  587    !,
  588    Vars = [Var|TV],
  589    Residuals = [Delays|TR],
  590    append(Clauses0, CT, Clauses),
  591    select_residuals(T, Bindings, TV, TR, CT).
  592select_residuals([H|T0], [H|T], Vars, Residuals, Clauses) :-
  593    select_residuals(T0, T, Vars, Residuals, Clauses).
  594
  595binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
  596    is_list(Residuals).
  597binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
  598    is_list(Residuals).
  599binding_residual('Residual'  = '$residual'(Residual),   'Residual', [Residual]) :-
  600    callable(Residual).
  601
  602binding_residual_clauses(
  603    '_wfs_residual_program' = '$wfs_residual_program'(Delays, Clauses),
  604    '_wfs_residual_program', Residuals, Clauses) :-
  605    phrase(delay_list(Delays), Residuals).
  606
  607delay_list(true) --> !.
  608delay_list((A,B)) --> !, delay_list(A), delay_list(B).
  609delay_list(M:A) --> !, [M:'$wfs_undefined'(A)].
  610delay_list(A) --> ['$wfs_undefined'(A)].
  611
  612add_projection(-, _, JSON, JSON) :- !.
  613add_projection(VarNames0, ResVars0, JSON0, JSON) :-
  614    append(ResVars0, ResVars1),
  615    sort(ResVars1, ResVars),
  616    subtract(VarNames0, ResVars, VarNames),
  617    add_projection(VarNames, JSON0, JSON).
  618
  619
  620%!  binding_to_html(+Pengine, +Binding, -Dict) is det.
  621%
  622%   Convert a variable binding into a JSON Dict. Note that this code
  623%   assumes that the module associated  with   Pengine  has the same
  624%   name as the Pengine.  The module is needed to
  625%
  626%   @arg Binding is a term binding(Vars,Term,Substitutions)
  627
  628binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
  629    JSON0 = json{variables:Vars, value:HTMLString},
  630    binding_write_options(ID, Options),
  631    term_html_string(Term, Vars, ID, HTMLString, Options),
  632    (   Substitutions == []
  633    ->  JSON = JSON0
  634    ;   maplist(subst_to_html(ID), Substitutions, HTMLSubst),
  635        JSON = JSON0.put(substitutions, HTMLSubst)
  636    ).
  637
  638binding_write_options(Pengine, Options) :-
  639    (   current_predicate(Pengine:screen_property/1),
  640        Pengine:screen_property(tabled(true))
  641    ->  Options = []
  642    ;   Options = [priority(699)]
  643    ).
  644
  645%!  term_html_string(+Term, +VarNames, +Module, -HTMLString,
  646%!                   +Options) is det.
  647%
  648%   Translate  Term  into  an  HTML    string   using  the  operator
  649%   declarations from Module. VarNames is a   list of variable names
  650%   that have this value.
  651
  652term_html_string(Term, Vars, Module, HTMLString, Options) :-
  653    setting(write_options, WOptions),
  654    merge_options(WOptions,
  655                  [ quoted(true),
  656                    numbervars(true),
  657                    module(Module)
  658                  | Options
  659                  ], WriteOptions),
  660    phrase(term_html(Term, Vars, WriteOptions), Tokens),
  661    with_output_to(string(HTMLString), print_html(Tokens)).
  662
  663%!  binding_term(+Term, +Vars, +WriteOptions)// is semidet.
  664%
  665%   Hook to render a Prolog result term as HTML. This hook is called
  666%   for each non-variable binding,  passing   the  binding  value as
  667%   Term, the names of the variables as   Vars and a list of options
  668%   for write_term/3.  If the hook fails, term//2 is called.
  669%
  670%   @arg    Vars is a list of variable names or `[]` if Term is a
  671%           _residual goal_.
  672
  673:- multifile binding_term//3.  674
  675term_html(Term, Vars, WriteOptions) -->
  676    { nonvar(Term) },
  677    binding_term(Term, Vars, WriteOptions),
  678    !.
  679term_html(Undef, _Vars, WriteOptions) -->
  680    { nonvar(Undef),
  681      Undef = '$wfs_undefined'(Term),
  682      !
  683    },
  684    html(span(class(wfs_undefined), \term(Term, WriteOptions))).
  685term_html(Term, _Vars, WriteOptions) -->
  686    term(Term, WriteOptions).
  687
  688%!  subst_to_html(+Module, +Binding, -JSON) is det.
  689%
  690%   Render   a   variable   substitution     resulting   from   term
  691%   factorization, in this case breaking a cycle.
  692
  693subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
  694    !,
  695    binding_write_options(ID, Options),
  696    term_html_string(Value, [Name], ID, HTMLString, Options).
  697subst_to_html(_, Term, _) :-
  698    assertion(Term = '$VAR'(_)).
  699
  700
  701%!  map_output(+ID, +Term, -JSON) is det.
  702%
  703%   Map an output term. This is the same for json-s and json-html.
  704
  705map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
  706    atomic(HTMLString),
  707    !,
  708    JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
  709    pengines:add_error_details(Term, JSON0, JSON1),
  710    (   Src = File:Line,
  711        \+ JSON1.get(location) = _
  712    ->  JSON = JSON1.put(_{location:_{file:File, line:Line}})
  713    ;   JSON = JSON1
  714    ).
  715map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
  716    (   atomic(Term)
  717    ->  Data = Term
  718    ;   is_dict(Term, json),
  719        ground(json)                % TBD: Check proper JSON object?
  720    ->  Data = Term
  721    ;   term_string(Term, Data)
  722    ).
  723
  724
  725%!  prolog_help:show_html_hook(+HTML)
  726%
  727%   Hook into help/1 to render the help output in the SWISH console.
  728
  729:- multifile
  730    prolog_help:show_html_hook/1.  731
  732prolog_help:show_html_hook(HTML) :-
  733    pengine_output,
  734    pengine_output(HTML).
  735
  736
  737                 /*******************************
  738                 *          SANDBOXING          *
  739                 *******************************/
  740
  741:- multifile
  742    sandbox:safe_primitive/1,       % Goal
  743    sandbox:safe_meta/2.            % Goal, Called
  744
  745sandbox:safe_primitive(pengines_io:pengine_listing(_)).
  746sandbox:safe_primitive(pengines_io:pengine_nl).
  747sandbox:safe_primitive(pengines_io:pengine_tab(_)).
  748sandbox:safe_primitive(pengines_io:pengine_flush_output).
  749sandbox:safe_primitive(pengines_io:pengine_print(_)).
  750sandbox:safe_primitive(pengines_io:pengine_write(_)).
  751sandbox:safe_primitive(pengines_io:pengine_read(_)).
  752sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)).
  753sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)).
  754sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
  755sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
  756sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
  757sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
  758sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
  759sandbox:safe_primitive(system:write_term(_,_)).
  760sandbox:safe_primitive(system:prompt(_,_)).
  761sandbox:safe_primitive(system:statistics(_,_)).
  762
  763sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
  764    sandbox:format_calls(Format, Args, Calls).
  765
  766
  767                 /*******************************
  768                 *         REDEFINITION         *
  769                 *******************************/
  770
  771%!  pengine_io_predicate(?Head)
  772%
  773%   True when Head describes the  head   of  a (system) IO predicate
  774%   that is redefined by the HTML binding.
  775
  776pengine_io_predicate(writeln(_)).
  777pengine_io_predicate(nl).
  778pengine_io_predicate(tab(_)).
  779pengine_io_predicate(flush_output).
  780pengine_io_predicate(format(_)).
  781pengine_io_predicate(format(_,_)).
  782pengine_io_predicate(read(_)).
  783pengine_io_predicate(read_line_to_string(_,_)).
  784pengine_io_predicate(read_line_to_codes(_,_)).
  785pengine_io_predicate(write_term(_,_)).
  786pengine_io_predicate(write(_)).
  787pengine_io_predicate(writeq(_)).
  788pengine_io_predicate(display(_)).
  789pengine_io_predicate(print(_)).
  790pengine_io_predicate(write_canonical(_)).
  791pengine_io_predicate(listing).
  792pengine_io_predicate(listing(_)).
  793pengine_io_predicate(portray_clause(_)).
  794
  795term_expansion(pengine_io_goal_expansion(_,_),
  796               Clauses) :-
  797    findall(Clause, io_mapping(Clause), Clauses).
  798
  799io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
  800    pengine_io_predicate(Head),
  801    Head =.. [Name|Args],
  802    atom_concat(pengine_, Name, BodyName),
  803    Mapped =.. [BodyName|Args].
  804
  805pengine_io_goal_expansion(_, _).
  806
  807
  808                 /*******************************
  809                 *      REBIND PENGINE I/O      *
  810                 *******************************/
  811
  812:- public
  813    stream_write/2,
  814    stream_read/2,
  815    stream_close/1.  816
  817:- thread_local
  818    pengine_io/2.  819
  820stream_write(Stream, Out) :-
  821    (   pengine_io(_,_)
  822    ->  send_html(pre(class(console), Out))
  823    ;   current_prolog_flag(pengine_main_thread, TID),
  824        thread_signal(TID, stream_write(Stream, Out))
  825    ).
  826stream_read(Stream, Data) :-
  827    (   pengine_io(_,_)
  828    ->  prompt(Prompt, Prompt),
  829        pengine_input(_{type:console, prompt:Prompt}, Data)
  830    ;   current_prolog_flag(pengine_main_thread, TID),
  831        call_in_thread(TID, stream_read(Stream, Data))
  832    ).
  833stream_close(_Stream).
  834
  835%!  pengine_bind_user_streams
  836%
  837%   Bind the pengine user  I/O  streams   to  a  Prolog  stream that
  838%   redirects  the  input  and   output    to   pengine_input/2  and
  839%   pengine_output/1. This results in  less   pretty  behaviour then
  840%   redefining the I/O predicates to  produce   nice  HTML, but does
  841%   provide functioning I/O from included libraries.
  842
  843pengine_bind_user_streams :-
  844    Err = Out,
  845    open_prolog_stream(pengines_io, write, Out, []),
  846    set_stream(Out, buffer(line)),
  847    open_prolog_stream(pengines_io, read,  In, []),
  848    set_stream(In,  alias(user_input)),
  849    set_stream(Out, alias(user_output)),
  850    set_stream(Err, alias(user_error)),
  851    set_stream(In,  alias(current_input)),
  852    set_stream(Out, alias(current_output)),
  853    assertz(pengine_io(In, Out)),
  854    thread_self(Me),
  855    thread_property(Me, id(Id)),
  856    set_prolog_flag(pengine_main_thread, Id),
  857    thread_at_exit(close_io).
  858
  859close_io :-
  860    retract(pengine_io(In, Out)),
  861    !,
  862    close(In, [force(true)]),
  863    close(Out, [force(true)]).
  864close_io.
  865
  866%!  pengine_output is semidet.
  867%!  pengine_input is semidet.
  868%
  869%   True when output (input) is redirected to a pengine.
  870
  871pengine_output :-
  872    current_output(Out),
  873    pengine_io(_, Out).
  874
  875pengine_input :-
  876    current_input(In),
  877    pengine_io(In, _).
  878
  879
  880%!  pengine_bind_io_to_html(+Module)
  881%
  882%   Redefine the built-in predicates for IO   to  send HTML messages
  883%   using pengine_output/1.
  884
  885pengine_bind_io_to_html(Module) :-
  886    forall(pengine_io_predicate(Head),
  887           bind_io(Head, Module)),
  888    pengine_bind_user_streams.
  889
  890bind_io(Head, Module) :-
  891    prompt(_, ''),
  892    redefine_system_predicate(Module:Head),
  893    functor(Head, Name, Arity),
  894    Head =.. [Name|Args],
  895    atom_concat(pengine_, Name, BodyName),
  896    Body =.. [BodyName|Args],
  897    assertz(Module:(Head :- Body)),
  898    compile_predicates([Module:Name/Arity])