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)  2009-2015, University of Amsterdam
    7                              VU University 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(html_head,
   37          [ html_resource/2,            % +Resource, +Attributes
   38            html_requires//1,           % +Resource
   39
   40            html_current_resource/1     % ?Resource
   41          ]).   42:- use_module(library(http/html_write)).   43:- use_module(library(http/mimetype)).   44:- use_module(library(http/http_path)).   45:- use_module(library(error)).   46:- use_module(library(lists)).   47:- use_module(library(occurs)).   48:- use_module(library(option)).   49:- use_module(library(ordsets)).   50:- use_module(library(assoc)).   51:- use_module(library(ugraphs)).   52:- use_module(library(apply)).   53:- use_module(library(debug)).

  104:- dynamic
  105    html_resource/3.                % Resource, Source, Properties
  106:- multifile
  107    html_resource/3,
  108    mime_include//2.                % +Mime, +Path

 html_resource(+About, +Properties) is det

Register an HTML head resource. About is either an atom that specifies an HTTP location or a term Alias(Sub). This works similar to absolute_file_name/2. See location_path/2 for details. Recognised properties are:

requires(+Requirements)

Other required script and css files. If this is a plain file name, it is interpreted relative to the declared resource. Requirements can be a list, which is equivalent to multiple requires properties.

virtual(+Bool)

If true (default false), do not include About itself, but only its dependencies. This allows for defining an alias for one or more resources.

ordered(+Bool)

Defines that the list of requirements is ordered, which means that each requirement in the list depends on its predecessor.

aggregate(+List)

States that About is an aggregate of the resources in List. This means that if both About and one of the elements of List appears in the dependencies, About is kept and the smaller one is dropped. If there are a number of dependencies on the small members, these are replaced with dependency on the big (aggregate) one, for example, to specify that a big javascript is actually the composition of a number of smaller ones.

mime_type(-Mime)

May be specified for non-virtual resources to specify the mime-type of the resource. By default, the mime type is derived from the file name using file_mime_type/2.

Registering the same About multiple times extends the properties defined for About. In particular, this allows for adding additional dependencies to a (virtual) resource.

  153html_resource(About, Properties) :-
  154    assert_resource(About, -, Properties).
  155
  156assert_resource(About, Location, Properties) :-
  157    retractall(html_resource(About, _, _)),
  158    assert(html_resource(About, Location, Properties)),
  159    clean_cache(About, Properties).
  160
  161system:term_expansion((:-html_resource(About, Properties)),
  162                      html_head:html_resource(About, File:Line, Properties)) :-
  163    source_location(File, Line),
  164    clean_cache(About, Properties).
  165
  166clean_cache(_About, Properties) :-
  167    clean_same_about_cache,
  168    (   memberchk(aggregate(_), Properties)
  169    ->  clean_aggregate_cache
  170    ;   true
  171    ).

 html_current_resource(?About) is nondet

True when About is a currently known resource.

  178html_current_resource(About) :-
  179    (   ground(About)
  180    ->  html_resource(About, _, _), !
  181    ;   html_resource(About, _, _)
  182    ).

 html_requires(+ResourceOrList)// is det

Include ResourceOrList and all dependencies derived from it and add them to the HTML head using html_post/2. The actual dependencies are computed during the HTML output phase by html_insert_resource//1.

  192html_requires(Required) -->
  193    html_post(head, 'html required'(Required)).
  194
  195:- multifile
  196    html_write:html_head_expansion/2.  197
  198html_write:html_head_expansion(In, Out) :-
  199    require_commands(In, Required, Rest),
  200    Required \== [],
  201    !,
  202    flatten(Required, Plain),
  203    Out = [ html_head:(\html_insert_resource(Plain))
  204          | Rest
  205          ].
  206
  207require_commands([], [], []).
  208require_commands([_:('html required'(Required))|T0], [Required|TR], R) :-
  209    !,
  210    require_commands(T0, TR, R).
  211require_commands([R|T0], TR, [R|T]) :-
  212    !,
  213    require_commands(T0, TR, T).

 html_insert_resource(+ResourceOrList)// is det

Actually include HTML head resources. Called through html_post//2 from html_requires//1 after rewrite by html_head_expansion/2. We are guaranteed we will only get one call that is passed a flat list of requested requirements. We have three jobs:

1. Figure out all indirect requirements
2. See whether we can use any `aggregate' resources
3. Put required resources before their requiree.

  228                % called from html_write:html_head_expansion/2
  229:- public html_insert_resource//1.  230
  231html_insert_resource(Required) -->
  232    { requirements(Required, Paths),
  233      debug(html(script), 'Requirements: ~q~nFinal: ~q', [Required, Paths])
  234    },
  235    html_include(Paths).
  236
  237requirements(Required, Paths) :-
  238    phrase(requires(Required), List),
  239    sort(List, Paths0),             % remove duplicates
  240    use_agregates(Paths0, Paths1, AggregatedBy),
  241    order_html_resources(Paths1, AggregatedBy, Paths2),
  242    exclude(virtual, Paths2, Paths).
  243
  244virtual('V'(_)).

 use_agregates(+Paths, -Aggregated, -AggregatedBy) is det

Try to replace sets of resources by an `aggregate', a large javascript or css file that combines the content of multiple small ones to reduce the number of files that must be transferred to the client. The current rule says that aggregates are used if at least half of the members are used.

  254use_agregates(Paths, Aggregated, AggregatedBy) :-
  255    empty_assoc(AggregatedBy0),
  256    use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy).
  257
  258use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy) :-
  259    current_aggregate(Aggregate, Parts, Size),
  260    ord_subtract(Paths, Parts, NotCovered),
  261    length(Paths, Len0),
  262    length(NotCovered, Len1),
  263    Covered is Len0-Len1,
  264    Covered >= Size/2,
  265    !,
  266    ord_add_element(NotCovered, Aggregate, NewPaths),
  267    add_aggregated_by(Parts, AggregatedBy0, Aggregate, AggregatedBy1),
  268    use_agregates(NewPaths, Aggregated, AggregatedBy1, AggregatedBy).
  269use_agregates(Paths, Paths, AggregatedBy, AggregatedBy).
  270
  271add_aggregated_by([], Assoc, _, Assoc).
  272add_aggregated_by([H|T], Assoc0, V, Assoc) :-
  273    put_assoc(H, Assoc0, V, Assoc1),
  274    add_aggregated_by(T, Assoc1, V, Assoc).
  275
  276
  277:- dynamic
  278    aggregate_cache_filled/0,
  279    aggregate_cache/3.  280:- volatile
  281    aggregate_cache_filled/0,
  282    aggregate_cache/3.  283
  284clean_aggregate_cache :-
  285    retractall(aggregate_cache_filled).

 current_aggregate(-Aggregate, -Parts, -Size) is nondet

True if Aggregate is a defined aggregate with Size Parts. All parts are canonical absolute HTTP locations and Parts is sorted to allow for processing using ordered set predicates.

  293current_aggregate(Path, Parts, Size) :-
  294    aggregate_cache_filled,
  295    !,
  296    aggregate_cache(Path, Parts, Size).
  297current_aggregate(Path, Parts, Size) :-
  298    retractall(aggregate_cache(_,_, _)),
  299    forall(uncached_aggregate(Path, Parts, Size),
  300           assert(aggregate_cache(Path, Parts, Size))),
  301    assert(aggregate_cache_filled),
  302    aggregate_cache(Path, Parts, Size).
  303
  304uncached_aggregate(Path, APartsS, Size) :-
  305    html_resource(Aggregate, _, Properties),
  306    memberchk(aggregate(Parts), Properties),
  307    http_absolute_location(Aggregate, Path, []),
  308    absolute_paths(Parts, Path, AParts),
  309    sort(AParts, APartsS),
  310    length(APartsS, Size).
  311
  312absolute_paths([], _, []).
  313absolute_paths([H0|T0], Base, [H|T]) :-
  314    http_absolute_location(H0, H, [relative_to(Base)]),
  315    absolute_paths(T0, Base, T).

 requires(+Spec)// is det

 requires(+Spec, +Base)// is det

True if Files is the set of files that need to be loaded for Spec. Note that Spec normally appears in Files, but this is not necessary (i.e. virtual resources or the usage of aggregate resources).

  326requires(Spec) -->
  327    requires(Spec, /).
  328
  329requires([], _) -->
  330    !,
  331    [].
  332requires([H|T], Base) -->
  333    !,
  334    requires(H, Base),
  335    requires(T, Base).
  336requires(Spec, Base) -->
  337    requires(Spec, Base, _, true).
  338
  339requires('V'(Spec), Base, Properties, Virtual) -->
  340    { nonvar(Spec) },
  341    !,
  342    requires(Spec, Base, Properties, Virtual).
  343requires(Spec, Base, Properties, Virtual) -->
  344    { res_properties(Spec, Properties),
  345      http_absolute_location(Spec, File, [relative_to(Base)])
  346    },
  347    (   { option(virtual(true), Properties)
  348        ; Virtual == false
  349        }
  350    ->  ['V'(Spec)]
  351    ;   [File]
  352    ),
  353    requires_from_properties(Properties, File).
  354
  355
  356requires_from_properties([], _) -->
  357    [].
  358requires_from_properties([H|T], Base) -->
  359    requires_from_property(H, Base),
  360    requires_from_properties(T, Base).
  361
  362requires_from_property(requires(What), Base) -->
  363    !,
  364    requires(What, Base).
  365requires_from_property(_, _) -->
  366    [].

 order_html_resources(+Requirements, +AggregatedBy, -Ordered) is det

Establish a proper order for the collected (sorted and unique) list of Requirements.

  374order_html_resources(Requirements, AggregatedBy, Ordered) :-
  375    requirements_graph(Requirements, AggregatedBy, Graph),
  376    (   top_sort(Graph, Ordered)
  377    ->  true
  378    ;   connect_graph(Graph, Start, Connected),
  379        top_sort(Connected, Ordered0),
  380        Ordered0 = [Start|Ordered]
  381    ).

 requirements_graph(+Requirements, +AggregatedBy, -Graph) is det

Produce an S-graph (see library(ugraphs)) that represents the dependencies in the list of Requirements. Edges run from required to requirer.

  389requirements_graph(Requirements, AggregatedBy, Graph) :-
  390    phrase(prerequisites(Requirements, AggregatedBy, Vertices, []), Edges),
  391    vertices_edges_to_ugraph(Vertices, Edges, Graph).
  392
  393prerequisites([], _, Vs, Vs) -->
  394    [].
  395prerequisites([R|T], AggregatedBy, Vs, Vt) -->
  396    prerequisites_for(R, AggregatedBy, Vs, Vt0),
  397    prerequisites(T, AggregatedBy, Vt0, Vt).
  398
  399prerequisites_for(R, AggregatedBy, Vs, Vt) -->
  400    { phrase(requires(R, /, Properties, true), Req0),
  401      delete(Req0, R, Req)
  402    },
  403    prop_edges(Properties),
  404    (   {Req == []}
  405    ->  {Vs = [R|Vt]}
  406    ;   req_edges(Req, AggregatedBy, R),
  407        {Vs = Vt}
  408    ).
  409
  410req_edges([], _, _) -->
  411    [].
  412req_edges([H|T], AggregatedBy, R) -->
  413    (   { get_assoc(H, AggregatedBy, Aggregate) }
  414    ->  [Aggregate-R]
  415    ;   [H-R]
  416    ),
  417    req_edges(T, AggregatedBy, R).

 prop_edges(+Properties)//

Subscribes a list of dependencies from resources that declare their requirements with ordered(true).

  424prop_edges(Properties) -->
  425    { option(ordered(true), Properties) },
  426    !,
  427    ordered_reqs(Properties).
  428prop_edges(_) --> [].
  429
  430ordered_reqs([]) --> [].
  431ordered_reqs([H|T]) --> ordered_req(H), ordered_reqs(T).
  432
  433ordered_req(requires([H|T])) -->
  434    { T \== [],
  435      !,
  436      absolute_req(H, File)
  437    },
  438    order_pairs(T, File).
  439ordered_req(_) --> [].
  440
  441order_pairs([H|T], P) -->
  442    !,
  443    { absolute_req(H, File)
  444    },
  445    [ P-File ],
  446    order_pairs(T, File).
  447order_pairs(_, _) --> [].
  448
  449absolute_req(Virtual, Abs) :-
  450    html_resource(Virtual, _, Properties),
  451    option(virtual(true), Properties),
  452    !,
  453    Abs = 'V'(Virtual).
  454absolute_req(Spec, Abs) :-
  455    http_absolute_location(Spec, Abs, [relative_to(/)]).

 connect_graph(+Graph, -Start, -Connected) is det

Turn Graph into a connected graph by putting a shared starting point before all vertices.

  463connect_graph([], 0, []) :- !.
  464connect_graph(Graph, Start, [Start-Vertices|Graph]) :-
  465    vertices(Graph, Vertices),
  466    Vertices = [First|_],
  467    before(First, Start).

 before(+Term, -Before) is det

Unify Before to a term that comes before Term in the standard order of terms.

Errors

- instantiation_error if Term is unbound.

  476before(X, _) :-
  477    var(X),
  478    !,
  479    instantiation_error(X).
  480before(Number, Start) :-
  481    number(Number),
  482    !,
  483    Start is Number - 1.
  484before(_, 0).

 res_properties(+Spec, -Properties) is det

True if Properties is the set of defined properties on Spec.

  491res_properties(Spec, Properties) :-
  492    findall(P, res_property(Spec, P), Properties0),
  493    list_to_set(Properties0, Properties).
  494
  495res_property(Spec, Property) :-
  496    same_about(Spec, About),
  497    html_resource(About, _, Properties),
  498    member(Property, Properties).
  499
  500:- dynamic
  501    same_about_cache/2.  502:- volatile
  503    same_about_cache/2.  504
  505clean_same_about_cache :-
  506    retractall(same_about_cache(_,_)).
  507
  508same_about(Spec, About) :-
  509    same_about_cache(Spec, Same),
  510    !,
  511    member(About, Same).
  512same_about(Spec, About) :-
  513    findall(A, uncached_same_about(Spec, A), List),
  514    assert(same_about_cache(Spec, List)),
  515    member(About, List).
  516
  517uncached_same_about(Spec, About) :-
  518    html_resource(About, _, _),
  519    same_resource(Spec, About).

 same_resource(+R1, +R2) is semidet

True if R1 an R2 represent the same resource. R1 and R2 are resource specifications are defined by http_absolute_location/3.

  527same_resource(R, R) :- !.
  528same_resource(R1, R2) :-
  529    resource_base_name(R1, B),
  530    resource_base_name(R2, B),
  531    http_absolute_location(R1, Path, []),
  532    http_absolute_location(R2, Path, []).
  533
  534:- dynamic
  535    base_cache/2.  536:- volatile
  537    base_cache/2.  538
  539resource_base_name(Spec, Base) :-
  540    (   base_cache(Spec, Base0)
  541    ->  Base = Base0
  542    ;   uncached_resource_base_name(Spec, Base0),
  543        assert(base_cache(Spec, Base0)),
  544        Base = Base0
  545    ).
  546
  547uncached_resource_base_name(Atom, Base) :-
  548    atomic(Atom),
  549    !,
  550    file_base_name(Atom, Base).
  551uncached_resource_base_name(Compound, Base) :-
  552    arg(1, Compound, Base0),
  553    file_base_name(Base0, Base).

 html_include(+PathOrList)// is det

Include to HTML resources that must be in the HTML <head> element. Currently onlu supports .js and .css files. Extend this to support more header material. Do not use this predicate directly. html_requires//1 is the public interface to include HTML resources.

Arguments:

HTTP	- location or list of these.

  565html_include([]) --> !.
  566html_include([H|T]) -->
  567    !,
  568    html_include(H),
  569    html_include(T).
  570html_include(Path) -->
  571    { res_property(Path, mime_type(Mime))
  572    },
  573    !,
  574    html_include(Mime, Path).
  575html_include(Path) -->
  576    { file_mime_type(Path, Mime) },
  577    !,
  578    html_include(Mime, Path).
  579
  580html_include(Mime, Path) -->
  581    mime_include(Mime, Path),
  582    !.    % user hook
  583html_include(text/css, Path) -->
  584    !,
  585    html(link([ rel(stylesheet),
  586                type('text/css'),
  587                href(Path)
  588              ], [])).
  589html_include(text/javascript, Path) -->
  590    !,
  591    html(script([ type('text/javascript'),
  592                  src(Path)
  593                ], [])).
  594html_include(Mime, Path) -->
  595    { print_message(warning, html_include(dont_know, Mime, Path))
  596    }.

 mime_include(+Mime, +Path)// is semidet

Hook called to include a link to an HTML resource of type Mime into the HTML head. The Mime type is computed from Path using file_mime_type/2. If the hook fails, two built-in rules for text/css and text/javascript are tried. For example, to include a =.pl= files as a Prolog script, use:

:- multifile
    html_head:mime_include//2.

html_head:mime_include(text/'x-prolog', Path) --> !,
    html(script([ type('text/x-prolog'),
                  src(Path)
                ],  [])).

  617                 /*******************************
  618                 *        CACHE CLEANUP         *
  619                 *******************************/
  620
  621:- multifile
  622    user:message_hook/3,
  623    prolog:message//1.  624:- dynamic
  625    user:message_hook/3.  626
  627user:message_hook(load_file(done(_Nesting, _File, _Action,
  628                                 _Module, _Time, _Clauses)),
  629                  _Level, _Lines) :-
  630    clean_same_about_cache,
  631    clean_aggregate_cache,
  632    fail.
  633
  634prolog:message(html_include(dont_know, Mime, Path)) -->
  635    [ 'Don\'t know how to include resource ~q (mime-type ~q)'-
  636      [Path, Mime]
  637    ].
  638
  639
  640                 /*******************************
  641                 *             EDIT             *
  642                 *******************************/
  643
  644% Allow edit(Location) to edit the :- html_resource declaration.
  645:- multifile
  646    prolog_edit:locate/3.  647
  648prolog_edit:locate(Path, html_resource(Spec), [file(File), line(Line)]) :-
  649    atom(Path),
  650    html_resource(Spec, File:Line, _Properties),
  651    sub_term(Path, Spec)