View source with raw 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, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(term_html,
   36          [ term//2                             % +Term, +Options
   37          ]).   38:- use_module(library(http/html_write)).   39:- use_module(library(option)).   40:- use_module(library(error)).   41:- use_module(library(debug)).   42
   43:- multifile
   44    blob_rendering//3,              % +Type, +Blob, +Options
   45    portray//2.                     % +Term, +Options

Represent Prolog terms as HTML

This file is primarily designed to support running Prolog applications over the web. It provides a replacement for write_term/2 which renders terms as structured HTML. */

 term(@Term, +Options)// is det
Render a Prolog term as a structured HTML tree. Options are passed to write_term/3. In addition, the following options are processed:
format(+Format)
Used for atomic values. Typically this is used to render a single value.
float_format(+Format)
If a float is rendered, it is rendered using format(string(S), Format, [Float])
To be done
- Cyclic terms.
- Attributed terms.
- Portray
- Test with Ulrich's write test set.
- Deal with numbervars and canonical.
   73term(Term, Options) -->
   74    { must_be(acyclic, Term),
   75      merge_options(Options,
   76                    [ priority(1200),
   77                      max_depth(1 000 000 000),
   78                      depth(0)
   79                    ],
   80                    Options1),
   81      dict_options(Dict, Options1)
   82    },
   83    any(Term, Dict),
   84    finalize_term(Term, Dict).
   85
   86
   87any(_, Options) -->
   88    { Options.depth >= Options.max_depth },
   89    !,
   90    html(span(class('pl-ellipsis'), ...)).
   91any(Term, Options) -->
   92    (   {   nonvar(Term)
   93        ;   attvar(Term)
   94        }
   95    ->  portray(Term, Options)
   96    ),
   97    !.
   98any(Term, Options) -->
   99    { primitive(Term, Class0),
  100      !,
  101      quote_atomic(Term, S, Options),
  102      primitive_class(Class0, Term, S, Class)
  103    },
  104    html(span(class(Class), S)).
  105any(Term, Options) -->
  106    { blob(Term,Type), Term \== [] },
  107    !,
  108    (   blob_rendering(Type,Term,Options)
  109    ->  []
  110    ;   html(span(class('pl-blob'),['<',Type,'>']))
  111    ).
  112any(Term, Options) -->
  113    { is_dict(Term), !
  114    },
  115    dict(Term, Options).
  116any(Term, Options) -->
  117    { assertion((compound(Term);Term==[]))
  118    },
  119    compound(Term, Options).
 compound(+Compound, +Options)// is det
Process a compound term.
  125compound('$VAR'(Var), Options) -->
  126    { Options.get(numbervars) == true,
  127      !,
  128      format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
  129      (   S == "_"
  130      ->  Class = 'pl-anon'
  131      ;   Class = 'pl-var'
  132      )
  133    },
  134    html(span(class(Class), S)).
  135compound(List, Options) -->
  136    { (   List == []
  137      ;   List = [_|_]                              % May have unbound tail
  138      ),
  139      !,
  140      arg_options(Options, _{priority:999}, ArgOptions)
  141    },
  142    list(List, ArgOptions).
  143compound({X}, Options) -->
  144    !,
  145    { arg_options(Options, _{priority:1200}, ArgOptions) },
  146    html(span(class('pl-curl'), [ '{', \any(X, ArgOptions), '}' ])).
  147compound(OpTerm, Options) -->
  148    { compound_name_arity(OpTerm, Name, 1),
  149      is_op1(Name, Type, Pri, ArgPri, Options),
  150      \+ Options.get(ignore_ops) == true
  151    },
  152    !,
  153    op1(Type, Pri, OpTerm, ArgPri, Options).
  154compound(OpTerm, Options) -->
  155    { compound_name_arity(OpTerm, Name, 2),
  156      is_op2(Name, LeftPri, Pri, RightPri, Options),
  157      \+ Options.get(ignore_ops) == true
  158    },
  159    !,
  160    op2(Pri, OpTerm, LeftPri, RightPri, Options).
  161compound(Compound, Options) -->
  162    { compound_name_arity(Compound, Name, Arity),
  163      quote_atomic(Name, S, Options.put(embrace, never)),
  164      arg_options(Options, _{priority:999}, ArgOptions),
  165      extra_classes(Classes, Options)
  166    },
  167    html(span(class(['pl-compound'|Classes]),
  168              [ span(class('pl-functor'), S),
  169                '(',
  170                \args(0, Arity, Compound, ArgOptions),
  171                ')'
  172              ])).
  173
  174extra_classes(['pl-level-0'], Options) :-
  175    Options.depth == 0,
  176    !.
  177extra_classes([], _).
 arg_options(+Options, -OptionsOut) is det
 arg_options(+Options, +Extra, -OptionsOut) is det
Increment depth in Options.
  184arg_options(Options, Options.put(depth, NewDepth)) :-
  185    NewDepth is Options.depth+1.
  186arg_options(Options, Extra, Options.put(depth, NewDepth).put(Extra)) :-
  187    NewDepth is Options.depth+1.
 args(+Arg0, +Arity, +Compound, +Options)//
Emit arguments of a compound term.
  193args(Arity, Arity, _, _) --> !.
  194args(I, Arity, Compound, ArgOptions) -->
  195    { NI is I + 1,
  196      arg(NI, Compound, Arg)
  197    },
  198    any(Arg, ArgOptions),
  199    (   {NI == Arity}
  200    ->  []
  201    ;   html(', '),
  202        args(NI, Arity, Compound, ArgOptions)
  203    ).
 list(+List, +Options)//
Emit a list. The List may have an unbound tail.
  209list(List, Options) -->
  210    html(span(class('pl-list'),
  211              ['[', \list_content(List, Options),
  212               ']'
  213              ])).
  214
  215list_content([], _Options) -->
  216    !,
  217    [].
  218list_content([H|T], Options) -->
  219    !,
  220    { arg_options(Options, ArgOptions)
  221    },
  222    any(H, Options),
  223    (   {T == []}
  224    ->  []
  225    ;   { Options.depth + 1 >= Options.max_depth }
  226    ->  html(['|',span(class('pl-ellipsis'), ...)])
  227    ;   {var(T) ; \+ T = [_|_]}
  228    ->  html('|'),
  229        tail(T, ArgOptions)
  230    ;   html(', '),
  231        list_content(T, ArgOptions)
  232    ).
  233
  234tail(Value, Options) -->
  235    {   var(Value)
  236    ->  Class = 'pl-var-tail'
  237    ;   Class = 'pl-nonvar-tail'
  238    },
  239    html(span(class(Class), \any(Value, Options))).
 is_op1(+Name, -Type, -Priority, -ArgPriority, +Options) is semidet
True if Name is an operator taking one argument of Type.
  245is_op1(Name, Type, Pri, ArgPri, Options) :-
  246    operator_module(Module, Options),
  247    current_op(Pri, OpType, Module:Name),
  248    argpri(OpType, Type, Pri, ArgPri),
  249    !.
  250
  251argpri(fx, prefix,  Pri0, Pri) :- Pri is Pri0 - 1.
  252argpri(fy, prefix,  Pri,  Pri).
  253argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
  254argpri(yf, postfix, Pri,  Pri).
 is_op2(+Name, -LeftPri, -Pri, -RightPri, +Options) is semidet
True if Name is an operator taking two arguments of Type.
  260is_op2(Name, LeftPri, Pri, RightPri, Options) :-
  261    operator_module(Module, Options),
  262    current_op(Pri, Type, Module:Name),
  263    infix_argpri(Type, LeftPri, Pri, RightPri),
  264    !.
  265
  266infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
  267infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
  268infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
 operator_module(-Module, +Options) is det
Find the module for evaluating operators.
  274operator_module(Module, Options) :-
  275    Module = Options.get(module),
  276    !.
  277operator_module(TypeIn, _) :-
  278    '$module'(TypeIn, TypeIn).
 op1(+Type, +Pri, +Term, +ArgPri, +Options)// is det
  282op1(Type, Pri, Term, ArgPri, Options) -->
  283    { Pri > Options.priority },
  284    !,
  285    html(['(', \op1(Type, Term, ArgPri, Options), ')']).
  286op1(Type, _, Term, ArgPri, Options) -->
  287    op1(Type, Term, ArgPri, Options).
  288
  289op1(prefix, Term, ArgPri, Options) -->
  290    { Term =.. [Functor,Arg],
  291      arg_options(Options, DepthOptions),
  292      FuncOptions = DepthOptions.put(embrace, never),
  293      ArgOptions  = DepthOptions.put(priority, ArgPri),
  294      quote_atomic(Functor, S, FuncOptions),
  295      extra_classes(Classes, Options)
  296    },
  297    html(span(class(['pl-compound'|Classes]),
  298              [ span(class('pl-prefix'), S),
  299                \space(Functor, Arg, FuncOptions, ArgOptions),
  300                \any(Arg, ArgOptions)
  301              ])).
  302op1(postfix, Term, ArgPri, Options) -->
  303    { Term =.. [Functor,Arg],
  304      arg_options(Options, DepthOptions),
  305      ArgOptions = DepthOptions.put(priority, ArgPri),
  306      FuncOptions = DepthOptions.put(embrace, never),
  307      quote_atomic(Functor, S, FuncOptions),
  308      extra_classes(Classes, Options)
  309    },
  310    html(span(class(['pl-compound'|Classes]),
  311              [ \any(Arg, ArgOptions),
  312                \space(Arg, Functor, ArgOptions, FuncOptions),
  313                span(class('pl-postfix'), S)
  314              ])).
 op2(+Pri, +Term, +LeftPri, +RightPri, +Options)// is det
  318op2(Pri, Term, LeftPri, RightPri, Options) -->
  319    { Pri > Options.priority },
  320    !,
  321    html(['(', \op2(Term, LeftPri, RightPri, Options), ')']).
  322op2(_, Term, LeftPri, RightPri, Options) -->
  323    op2(Term, LeftPri, RightPri, Options).
  324
  325op2(Term, LeftPri, RightPri, Options) -->
  326    { Term =.. [Functor,Left,Right],
  327      arg_options(Options, DepthOptions),
  328      LeftOptions  = DepthOptions.put(priority, LeftPri),
  329      FuncOptions  = DepthOptions.put(embrace, never),
  330      RightOptions = DepthOptions.put(priority, RightPri),
  331      (   (   need_space(Left, Functor, LeftOptions, FuncOptions)
  332          ;   need_space(Functor, Right, FuncOptions, RightOptions)
  333          )
  334      ->  Space = ' '
  335      ;   Space = ''
  336      ),
  337      quote_op(Functor, S, Options),
  338      extra_classes(Classes, Options)
  339    },
  340    html(span(class(['pl-compound'|Classes]),
  341              [ \any(Left, LeftOptions),
  342                Space,
  343                span(class('pl-infix'), S),
  344                Space,
  345                \any(Right, RightOptions)
  346              ])).
 space(@T1, @T2, +Options)//
Emit a space if omitting a space between T1 and T2 would cause the two terms to join.
  353space(T1, T2, LeftOptions, RightOptions) -->
  354    { need_space(T1, T2, LeftOptions, RightOptions) },
  355    html(' ').
  356space(_, _, _, _) -->
  357    [].
  358
  359need_space(T1, T2, _, _) :-
  360    (   is_solo(T1)
  361    ;   is_solo(T2)
  362    ),
  363    !,
  364    fail.
  365need_space(T1, T2, LeftOptions, RightOptions) :-
  366    end_code_type(T1, TypeR, LeftOptions.put(side, right)),
  367    end_code_type(T2, TypeL, RightOptions.put(side, left)),
  368    \+ no_space(TypeR, TypeL).
  369
  370no_space(punct, _).
  371no_space(_, punct).
  372no_space(quote(R), quote(L)) :-
  373    !,
  374    R \== L.
  375no_space(alnum, symbol).
  376no_space(symbol, alnum).
 end_code_type(+Term, -Code, Options)
True when code is the first/last character code that is emitted by printing Term using Options.
  383end_code_type(_, Type, Options) :-
  384    Options.depth >= Options.max_depth,
  385    !,
  386    Type = symbol.
  387end_code_type(Term, Type, Options) :-
  388    primitive(Term, _),
  389    !,
  390    quote_atomic(Term, S, Options),
  391    end_type(S, Type, Options).
  392end_code_type(Dict, Type, Options) :-
  393    is_dict(Dict, Tag),
  394    !,
  395    (   Options.side == left
  396    ->  end_code_type(Tag, Type, Options)
  397    ;   Type = punct
  398    ).
  399end_code_type('$VAR'(Var), Type, Options) :-
  400    Options.get(numbervars) == true,
  401    !,
  402    format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
  403    end_type(S, Type, Options).
  404end_code_type(List, Type, _) :-
  405    (   List == []
  406    ;   List = [_|_]
  407    ),
  408    !,
  409    Type = punct.
  410end_code_type(OpTerm, Type, Options) :-
  411    compound_name_arity(OpTerm, Name, 1),
  412    is_op1(Name, OpType, Pri, ArgPri, Options),
  413    \+ Options.get(ignore_ops) == true,
  414    !,
  415    (   Pri > Options.priority
  416    ->  Type = punct
  417    ;   (   OpType == prefix
  418        ->  end_code_type(Name, Type, Options)
  419        ;   arg(1, OpTerm, Arg),
  420            arg_options(Options, ArgOptions),
  421            end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
  422        )
  423    ).
  424end_code_type(OpTerm, Type, Options) :-
  425    compound_name_arity(OpTerm, Name, 2),
  426    is_op2(Name, LeftPri, Pri, _RightPri, Options),
  427    \+ Options.get(ignore_ops) == true,
  428    !,
  429    (   Pri > Options.priority
  430    ->  Type = punct
  431    ;   arg(1, OpTerm, Arg),
  432        arg_options(Options, ArgOptions),
  433        end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
  434    ).
  435end_code_type(Compound, Type, Options) :-
  436    compound_name_arity(Compound, Name, _),
  437    end_code_type(Name, Type, Options).
  438
  439end_type(S, Type, Options) :-
  440    number(S),
  441    !,
  442    (   (S < 0 ; S == -0.0),
  443        Options.side == left
  444    ->  Type = symbol
  445    ;   Type = alnum
  446    ).
  447end_type(S, Type, Options) :-
  448    Options.side == left,
  449    !,
  450    sub_string(S, 0, 1, _, Start),
  451    syntax_type(Start, Type).
  452end_type(S, Type, _) :-
  453    sub_string(S, _, 1, 0, End),
  454    syntax_type(End, Type).
  455
  456syntax_type("\"", quote(double)) :- !.
  457syntax_type("\'", quote(single)) :- !.
  458syntax_type("\`", quote(back))   :- !.
  459syntax_type(S, Type) :-
  460    string_code(1, S, C),
  461    (   code_type(C, prolog_identifier_continue)
  462    ->  Type = alnum
  463    ;   code_type(C, prolog_symbol)
  464    ->  Type = symbol
  465    ;   code_type(C, space)
  466    ->  Type = layout
  467    ;   Type = punct
  468    ).
 dict(+Term, +Options)//
  473dict(Term, Options) -->
  474    { dict_pairs(Term, Tag, Pairs),
  475      quote_atomic(Tag, S, Options.put(embrace, never)),
  476      arg_options(Options, ArgOptions)
  477    },
  478    html(span(class('pl-dict'),
  479              [ span(class('pl-tag'), S),
  480                '{',
  481                \dict_kvs(Pairs, ArgOptions),
  482                '}'
  483              ])).
  484
  485dict_kvs([], _) --> [].
  486dict_kvs(_, Options) -->
  487    { Options.depth >= Options.max_depth },
  488    !,
  489    html(span(class('pl-ellipsis'), ...)).
  490dict_kvs(KVs, Options) -->
  491    dict_kvs2(KVs, Options).
  492
  493dict_kvs2([K-V|T], Options) -->
  494    { quote_atomic(K, S, Options),
  495      end_code_type(V, VType, Options.put(side, left)),
  496      (   VType == symbol
  497      ->  VSpace = ' '
  498      ;   VSpace = ''
  499      ),
  500      arg_options(Options, ArgOptions)
  501    },
  502    html([ span(class('pl-key'), S),
  503           ':',                             % FIXME: spacing
  504           VSpace,
  505           \any(V, ArgOptions)
  506         ]),
  507    (   {T==[]}
  508    ->  []
  509    ;   html(', '),
  510        dict_kvs2(T, Options)
  511    ).
  512
  513quote_atomic(Float, String, Options) :-
  514    float(Float),
  515    Format = Options.get(float_format),
  516    !,
  517    format(string(String), Format, [Float]).
  518quote_atomic(Plain, String, Options) :-
  519    atomic(Plain),
  520    Format = Options.get(format),
  521    !,
  522    format(string(String), Format, [Plain]).
  523quote_atomic(Plain, String, Options) :-
  524    rational(Plain),
  525    \+ integer(Plain),
  526    !,
  527    operator_module(Module, Options),
  528    format(string(String), '~W', [Plain, [module(Module)]]).
  529quote_atomic(Plain, Plain, _) :-
  530    number(Plain),
  531    !.
  532quote_atomic(Plain, String, Options) :-
  533    Options.get(quoted) == true,
  534    !,
  535    (   Options.get(embrace) == never
  536    ->  format(string(String), '~q', [Plain])
  537    ;   format(string(String), '~W', [Plain, Options])
  538    ).
  539quote_atomic(Var, String, Options) :-
  540    var(Var),
  541    !,
  542    format(string(String), '~W', [Var, Options]).
  543quote_atomic(Plain, Plain, _).
  544
  545quote_op(Op, S, _Options) :-
  546    is_solo(Op),
  547    !,
  548    S = Op.
  549quote_op(Op, S, Options) :-
  550    quote_atomic(Op, S, Options.put(embrace,never)).
  551
  552is_solo(Var) :-
  553    var(Var), !, fail.
  554is_solo(',').
  555is_solo(';').
  556is_solo('!').
 primitive(+Term, -Class) is semidet
True if Term is a primitive term, rendered using the CSS class Class.
  563primitive(Term, Type) :- var(Term),      !, Type = 'pl-avar'.
  564primitive(Term, Type) :- atom(Term),     !, Type = 'pl-atom'.
  565primitive(Term, Type) :- string(Term),   !, Type = 'pl-string'.
  566primitive(Term, Type) :- integer(Term),  !, Type = 'pl-int'.
  567primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
  568primitive(Term, Type) :- float(Term),    !, Type = 'pl-float'.
 primitive_class(+Class0, +Value, -String, -Class) is det
Fixup the CSS class for lexical variations. Used to find quoted atoms.
  575primitive_class('pl-atom', Atom, String, Class) :-
  576    \+ atom_string(Atom, String),
  577    !,
  578    Class = 'pl-quoted-atom'.
  579primitive_class(Class, _, _, Class).
 finalize_term(+Term, +Dict)// is det
Handle the full_stop(Bool) and nl(Bool) options.
  586finalize_term(Term, Dict) -->
  587    (   { true == Dict.get(full_stop) }
  588    ->  space(Term, '.', Dict, Dict),
  589        (   { true == Dict.get(nl) }
  590        ->  html(['.', br([])])
  591        ;   html('. ')
  592        )
  593    ;   (   { true == Dict.get(nl) }
  594        ->  html(br([]))
  595        ;   []
  596        )
  597    ).
  598
  599
  600                 /*******************************
  601                 *             HOOKS            *
  602                 *******************************/
 blob_rendering(+BlobType, +Blob, +WriteOptions)// is semidet
Hook to render blob atoms as HTML. This hook is called whenever a blob atom is encountered while rendering a compound term as HTML. The blob type is provided to allow efficient indexing without having to examine the blob. If this predicate fails, the blob is rendered as an HTML SPAN with class 'pl-blob' containing BlobType as text.