1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2018, 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(md_eval,
   37          [ swish_provides/1            % ?Term
   38          ]).   39:- use_module(library(modules)).   40:- use_module(library(apply)).   41:- use_module(library(lists)).   42:- use_module(library(debug)).   43:- use_module(library(option)).   44:- use_module(library(occurs)).   45:- use_module(library(settings)).   46:- use_module(library(error)).   47:- use_module(library(pldoc/doc_wiki)).   48:- use_module(library(dcg/basics)).   49:- use_module(library(time)).   50
   51:- use_module(config).   52
   53:- multifile
   54    provides/1.                                 % ?Term
   55
   56:- setting(time_limit, number, 10,
   57           "Timit limit for evaluating a ```{eval} cell").   58
   59/** <module> Provide evaluable markdown
   60
   61This  module  adds  evaluable  sections  to   markdown  cells  in  SWISH
   62notebooks. Such cells are written as
   63
   64  ==
   65  ```{eval}
   66  <Prolog code>
   67  ```
   68  ==
   69*/
   70
   71%!  eval_dom(+DOM0, -DOM, +Options) is semidet.
   72%
   73%   This predicate post-processes  the  wiki  DOM   result  if  the  DOM
   74%   contains at least one  `eval`  code   fragment.  The  evaluation  is
   75%   executed  in  a  sandboxed  environment,   much  like  the  Pengines
   76%   infrastructure.
   77%
   78%   A code fragment is represented by a term of this shape:
   79%
   80%       pre([class(code), ext(Ext)], Text)
   81
   82eval_dom(DOM0, DOM, Options) :-
   83    contains_eval(DOM0),
   84    !,
   85    in_temporary_module(
   86        Module,
   87        prepare(Module),
   88        md_eval(Module, Options, DOM0, DOM, 0, _)).
   89
   90prepare(Module) :-
   91    setting(swish:program_space, SpaceLimit),
   92    set_module(Module:program_space(SpaceLimit)),
   93    delete_import_module(Module, user),
   94    add_import_module(Module, swish, start).
   95
   96%!  md_eval(+Module, +Options, +DOM0, -DOM, +FragI0, -FragI1)
   97
   98md_eval(Module, Options, Pre, Evaluated, I0, I) :-
   99    pre(Pre, eval, Code),
  100    !,
  101    eval(Module, I0, Code, Evaluated, Options),
  102    I is I0 + 1.
  103md_eval(Module, Options, Compound, Evaluated, I0, I) :-
  104    compound(Compound),
  105    !,
  106    compound_name_arguments(Compound, Name, Args0),
  107    foldl(md_eval(Module, Options), Args0, Args, I0, I),
  108    compound_name_arguments(Evaluated, Name, Args).
  109md_eval(_, _, DOM, DOM, I, I) :-
  110    !.
  111
  112:- meta_predicate
  113    call_collect_messages(0, -).  114
  115eval(Module, I, Code, div(class(eval), Evaluated), Options) :-
  116    option(time_limit(Limit), Options, 10),
  117    catch(( call_collect_messages(
  118                call_with_time_limit(
  119                    Limit,
  120                    do_eval(Module, I, Code, Evaluated0, Options)),
  121                Messages),
  122            append(Evaluated0, Messages, Evaluated)
  123          ),
  124          Error,
  125          failed(Error, Evaluated)).
  126
  127do_eval(Module, I, Code, [div(class(output), DOM)], _Options) :-
  128    debug(md(eval), 'Evaluating ~p', [Code]),
  129    format(atom(Id), 'eval://~w-~w', [Module, I]),
  130    with_output_to(
  131        codes(Codes),
  132        setup_call_cleanup(
  133            open_string(Code, In),
  134            load_files(Module:Id,
  135                       [ stream(In),
  136                         sandboxed(true)
  137                       ]),
  138            close(In))),
  139    eval_to_dom(Codes, DOM).
  140
  141eval_to_dom(Codes, DOM) :-
  142    phrase(is_html, Codes),
  143    E = error(_,_),
  144    catch(setup_call_cleanup(
  145              open_string(Codes, In),
  146              load_html(In, DOM, []),
  147              close(In)),
  148          E, fail),
  149    !.
  150eval_to_dom(Codes, DOM) :-
  151    wiki_codes_to_dom(Codes, [], DOM).
  152
  153is_html -->
  154    blanks, "<", tag(Tag),
  155    string(_),
  156    "</", tag(Tag), ">", blanks.
  157
  158tag([H|T]) -->
  159    alpha(H),
  160    alphas(T).
  161
  162alpha(H) -->
  163    [H],
  164    { between(0'a, 0'z, H) }.
  165
  166alphas([H|T]) -->
  167    alpha(H),
  168    !,
  169    alphas(T).
  170alphas([]) -->
  171    [].
  172
  173contains_eval(DOM) :-
  174    sub_term(Pre, DOM),
  175    nonvar(Pre),
  176    pre(Pre, eval, _),
  177    !.
  178
  179pre(pre(Attrs, Text), Ext, Text) :-
  180    atomic(Text),
  181    is_list(Attrs),
  182    ground(Attrs),
  183    memberchk(ext(Ext), Attrs).
  184
  185:- thread_local
  186    saved_message/1.  187
  188failed(Error, [div(class(error), Message)]) :-
  189    message_to_string(Error, Message).
  190
  191call_collect_messages(Goal, Messages) :-
  192    setup_call_cleanup(
  193        asserta((user:thread_message_hook(Term, Kind, Lines) :-
  194                   save_message(Term, Kind, Lines)), Ref),
  195        Goal,
  196        collect_messages(Ref, Messages)).
  197
  198save_message(_Term, Kind, Lines) :-
  199    kind_prefix(Kind, Prefix),
  200    with_output_to(
  201        string(Msg),
  202        print_message_lines(current_output, Prefix, Lines)),
  203    assertz(saved_message(pre(class([eval,Kind]), Msg))).
  204
  205kind_prefix(error,   '% ERROR: ').
  206kind_prefix(warning, '% Warning: ').
  207
  208collect_messages(Ref, Messages) :-
  209    erase(Ref),
  210    findall(Msg, retract(saved_message(Msg)), Messages).
  211
  212
  213		 /*******************************
  214		 *           CONDITIONS		*
  215		 *******************************/
  216
  217%!  swish_provides(?Term) is nondet.
  218%
  219%   True when Term describes a  provided   feature  of the current SWISH
  220%   instances.  Provided Term values are:
  221%
  222%     - plugin(Name)
  223%       True when Name is the name of a loaded plugin
  224%
  225%   In addition, plugins may provide additional terms by adding facts to
  226%   swish_config:config(provides, Term).
  227
  228swish_provides(plugin(Plugin)) :-
  229    swish_has_plugin(Plugin).
  230swish_provides(Term) :-
  231    provides(Term).
  232
  233
  234%!  swish_has_plugin(+Name) is nondet.
  235%
  236%   True when Name is the name of a loaded plugin.  This predicate is
  237%   intended for dynamic markdown pages.
  238
  239swish_has_plugin(Name) :-
  240    var(Name), !,
  241    distinct(Dir,
  242             absolute_file_name(
  243                 config_enabled(.),
  244                 Dir,
  245                 [ solutions(all),
  246                   file_type(directory)
  247                 ])),
  248    directory_files(Dir, Files),
  249    member(File, Files),
  250    directory_file_path(Dir, File, Source),
  251    source_file(Source),
  252    file_name_extension(Name, _, File).
  253swish_has_plugin(Name) :-
  254    must_be(atom, Name),
  255    absolute_file_name(
  256        config_enabled(Name),
  257        File,
  258        [ solutions(all),
  259          file_type(prolog)
  260        ]),
  261    source_file(File),
  262    !.
  263
  264sandbox:safe_primitive(md_eval:swish_provides(_)).
  265
  266
  267		 /*******************************
  268		 *           ACTIVATE		*
  269		 *******************************/
  270
  271:- multifile
  272    swish_markdown:dom_expansion/2.  273
  274swish_markdown:dom_expansion(DOM0, DOM) :-
  275    setting(time_limit, Limit),
  276    Limit > 0,
  277    eval_dom(DOM0, DOM, [time_limit(Limit)])