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