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).