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)).   54
   55
   56/** <module> Automatic inclusion of CSS and scripts links
   57
   58This library allows for  abstract  declaration   of  available  CSS  and
   59Javascript resources and their dependencies using html_resource/2. Based
   60on these declarations, html generating code  can declare that it depends
   61on specific CSS or Javascript functionality,   after  which this library
   62ensures  that  the  proper  links   appear    in   the  HTML  head.  The
   63implementation is based on mail  system   implemented  by html_post/2 of
   64library html_write.pl.
   65
   66Declarations come in two forms. First of all http locations are declared
   67using the http_path.pl library. Second,   html_resource/2 specifies HTML
   68resources to be used in the =head= and their dependencies. Resources are
   69currently limited to Javascript files (.js)  and style sheets (.css). It
   70is  trivial  to  add  support  for  other  material  in  the  head.  See
   71html_include//1.
   72
   73For usage in HTML generation,  there   is  the DCG rule html_requires//1
   74that demands named resources  in  the   HTML  head.
   75
   76## About resource ordering {#html-resource-ordering}
   77
   78All calls to html_requires//1 for the page are collected and duplicates
   79are removed.  Next, the following steps are taken:
   80
   81    1. Add all dependencies to the set
   82    2. Replace multiple members by `aggregate' scripts or css files.
   83       see use_agregates/4.
   84    3. Order all resources by demanding that their dependencies
   85       preceede the resource itself.  Note that the ordering of
   86       resources in the dependency list is *ignored*.  This implies
   87       that if the order matters the dependency list must be split
   88       and only the primary dependency must be added.
   89
   90## Debugging dependencies {#html-resource-debugging}
   91
   92Use ?- debug(html(script)). to  see  the   requested  and  final  set of
   93resources. All declared resources  are   in  html_resource/3. The edit/1
   94command recognises the names of HTML resources.
   95
   96## Predicates {#html-resource-predicates}
   97
   98@tbd    Possibly we should add img//2 to include images from symbolic
   99        path notation.
  100@tbd    It would be nice if the HTTP file server could use our location
  101        declarations.
  102*/
  103
  104:- dynamic
  105    html_resource/3.                % Resource, Source, Properties
  106:- multifile
  107    html_resource/3,
  108    mime_include//2.                % +Mime, +Path
  109
  110%!  html_resource(+About, +Properties) is det.
  111%
  112%   Register an HTML head resource.  About   is  either an atom that
  113%   specifies an HTTP location or  a   term  Alias(Sub).  This works
  114%   similar to absolute_file_name/2.  See   http:location_path/2  for
  115%   details.  Recognised properties are:
  116%
  117%           * requires(+Requirements)
  118%           Other required script and css files.  If this is a plain
  119%           file name, it is interpreted relative to the declared
  120%           resource.  Requirements can be a list, which is equivalent
  121%           to multiple requires properties.
  122%
  123%           * virtual(+Bool)
  124%           If =true= (default =false=), do not include About itself,
  125%           but only its dependencies.  This allows for defining an
  126%           alias for one or more resources.
  127%
  128%           * ordered(+Bool)
  129%           Defines that the list of requirements is ordered, which
  130%           means that each requirement in the list depends on its
  131%           predecessor.
  132%
  133%           * aggregate(+List)
  134%           States that About is an aggregate of the resources in
  135%           List. This means that if both About and one of the
  136%           elements of List appears in the dependencies, About
  137%           is kept and the smaller one is dropped. If there are a
  138%           number of dependencies on the small members, these are
  139%           replaced with dependency on the big (aggregate) one,
  140%           for example, to specify that a big javascript is
  141%           actually the composition of a number of smaller ones.
  142%
  143%           * mime_type(-Mime)
  144%           May be specified for non-virtual resources to specify
  145%           the mime-type of the resource.  By default, the mime
  146%           type is derived from the file name using
  147%           file_mime_type/2.
  148%
  149%   Registering the same About multiple times extends the properties
  150%   defined  for  About.  In  particular,  this  allows  for  adding
  151%   additional dependencies to a (virtual) resource.
  152
  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    ).
  172
  173
  174%!  html_current_resource(?About) is nondet.
  175%
  176%   True when About is a currently known resource.
  177
  178html_current_resource(About) :-
  179    (   ground(About)
  180    ->  html_resource(About, _, _), !
  181    ;   html_resource(About, _, _)
  182    ).
  183
  184
  185%!  html_requires(+ResourceOrList)// is det.
  186%
  187%   Include ResourceOrList and all dependencies  derived from it and
  188%   add them to the  HTML  =head=   using  html_post/2.  The  actual
  189%   dependencies are computed  during  the   HTML  output  phase  by
  190%   html_insert_resource//1.
  191
  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).
  214
  215
  216%!  html_insert_resource(+ResourceOrList)// is det.
  217%
  218%   Actually   include   HTML   head   resources.   Called   through
  219%   html_post//2   from   html_requires//1   after     rewrite    by
  220%   html_head_expansion/2. We are guaranteed we   will  only get one
  221%   call that is passed a flat   list  of requested requirements. We
  222%   have three jobs:
  223%
  224%       1. Figure out all indirect requirements
  225%       2. See whether we can use any `aggregate' resources
  226%       3. Put required resources before their requiree.
  227
  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'(_)).
  245
  246%!  use_agregates(+Paths, -Aggregated, -AggregatedBy) is det.
  247%
  248%   Try to replace sets of  resources   by  an  `aggregate', a large
  249%   javascript or css file that  combines   the  content of multiple
  250%   small  ones  to  reduce  the  number   of  files  that  must  be
  251%   transferred to the client. The current rule says that aggregates
  252%   are used if at least half of the members are used.
  253
  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).
  286
  287%!  current_aggregate(-Aggregate, -Parts, -Size) is nondet.
  288%
  289%   True if Aggregate is a defined   aggregate  with Size Parts. All
  290%   parts are canonical absolute HTTP locations  and Parts is sorted
  291%   to allow for processing using ordered set predicates.
  292
  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).
  316
  317
  318%!  requires(+Spec)// is det.
  319%!  requires(+Spec, +Base)// is det.
  320%
  321%   True if Files is the set of  files   that  need to be loaded for
  322%   Spec. Note that Spec normally appears in  Files, but this is not
  323%   necessary (i.e. virtual resources  or   the  usage  of aggregate
  324%   resources).
  325
  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    [].
  367
  368
  369%!  order_html_resources(+Requirements, +AggregatedBy, -Ordered) is det.
  370%
  371%   Establish a proper order for the   collected (sorted and unique)
  372%   list of Requirements.
  373
  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    ).
  382
  383%!  requirements_graph(+Requirements, +AggregatedBy, -Graph) is det.
  384%
  385%   Produce an S-graph (see library(ugraphs))   that  represents the
  386%   dependencies  in  the  list  of  Requirements.  Edges  run  from
  387%   required to requirer.
  388
  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).
  418
  419%!  prop_edges(+Properties)//
  420%
  421%   Subscribes a list of dependencies   from  resources that declare
  422%   their requirements with ordered(true).
  423
  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(/)]).
  456
  457
  458%!  connect_graph(+Graph, -Start, -Connected) is det.
  459%
  460%   Turn Graph into a connected graph   by putting a shared starting
  461%   point before all vertices.
  462
  463connect_graph([], 0, []) :- !.
  464connect_graph(Graph, Start, [Start-Vertices|Graph]) :-
  465    vertices(Graph, Vertices),
  466    Vertices = [First|_],
  467    before(First, Start).
  468
  469%!  before(+Term, -Before) is det.
  470%
  471%   Unify Before to a term that comes   before  Term in the standard
  472%   order of terms.
  473%
  474%   @error instantiation_error if Term is unbound.
  475
  476before(X, _) :-
  477    var(X),
  478    !,
  479    instantiation_error(X).
  480before(Number, Start) :-
  481    number(Number),
  482    !,
  483    Start is Number - 1.
  484before(_, 0).
  485
  486
  487%!  res_properties(+Spec, -Properties) is det.
  488%
  489%   True if Properties is the set of defined properties on Spec.
  490
  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).
  520
  521
  522%!  same_resource(+R1, +R2) is semidet.
  523%
  524%   True if R1 an R2 represent  the   same  resource.  R1 and R2 are
  525%   resource specifications are defined by http_absolute_location/3.
  526
  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).
  554
  555%!  html_include(+PathOrList)// is det.
  556%
  557%   Include to HTML resources  that  must   be  in  the  HTML <head>
  558%   element. Currently onlu supports  =|.js|=   and  =|.css|= files.
  559%   Extend this to support more  header   material.  Do not use this
  560%   predicate directly. html_requires//1 is the  public interface to
  561%   include HTML resources.
  562%
  563%   @param  HTTP location or list of these.
  564
  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    }.
  597
  598%!  mime_include(+Mime, +Path)// is semidet.
  599%
  600%   Hook called to include a link to   an HTML resource of type Mime
  601%   into the HTML head. The Mime type   is  computed from Path using
  602%   file_mime_type/2. If the hook  fails,   two  built-in  rules for
  603%   `text/css` and `text/javascript` are  tried.   For  example,  to
  604%   include a =.pl= files as a Prolog script, use:
  605%
  606%     ```
  607%     :- multifile
  608%         html_head:mime_include//2.
  609%
  610%     html_head:mime_include(text/'x-prolog', Path) --> !,
  611%         html(script([ type('text/x-prolog'),
  612%                       src(Path)
  613%                     ],  [])).
  614%
  615%     ```
  616
  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)