1/*  Part of Extended Tools for SWI-Prolog
    2
    3    Author:        Edison Mera Menendez
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xtools
    6    Copyright (C): 2015, Process Design Center, Breda, The Netherlands.
    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(ws_cover, [cache_file_lines/0]).   36
   37:- reexport(library(ws_browser)).   38:- use_module(library(ntabling)).   39:- use_module(library(apply)).   40:- use_module(library(gcover)).   41:- use_module(library(http/html_write)).   42:- use_module(library(module_files)).   43:- use_module(library(pldoc/doc_htmlsrc)).   44
   45ws_browser:provides_method(gcover).
   46
   47:- table
   48       cov_source_file/1,
   49       source_file_line/4.   50
   51ws_browser:fetch_files_properties_hook(gcover, [ccov, clss, lcov, lits], FileMG) :-
   52    findall(File-[CCov, Clss, LCov, Lits],
   53            ( source_file(File),
   54              cover_info(File, CCov, Clss, LCov, Lits)
   55            ), FileMU),
   56    sort(FileMU, FileML),
   57    group_pairs_by_key(FileML, FileMG).
   58
   59cov_source_file(File) :-
   60    distinct(File, covered_db(File, _, _, _, _, _)).
   61
   62cache_file_lines :-
   63    findall(File, cov_source_file(File), FileL),
   64    length(FileL, N),
   65    forall(nth1(I, FileL, File),
   66           ( format(user_error, "Caching ~w of ~w files\r", [I, N]),
   67             ignore(source_file_line(File, _, _, _))
   68           )),
   69    nl(user_error).
   70
   71cover_info(File, CCov, Clss, LCov, Lits) :-
   72    CountC = count(0, 0),
   73    CountL = count(0, 0),
   74    ( source_file_line(File, L1, L2, Scope),
   75      ( Scope = cl(_)
   76      ->Count = CountC
   77      ; Count = CountL
   78      ),
   79      Count = count(C1, N1),
   80      succ(N1, N),
   81      nb_setarg(2, Count, N),
   82      ( covered_db(File, L1, L2, _, _, _)
   83      ->succ(C1, C),
   84        nb_setarg(1, Count, C)
   85      ; true
   86      ),
   87      fail
   88    ; true
   89    ),
   90    CountC = count(CCov, Clss),
   91    CountL = count(LCov, Lits).
 ports_color(List:list(pair), Color:atm)
Convention: the color that affects the clause should be darker than those that affects only literals.

Keep the order since it is the priority.

  100ports_color([(success)-_, failure-_, multi-_], lightpink).
  101ports_color([(success)-_, multi-_],            yellowgreen).
  102ports_color([(success)-_, failure-_],          orange).
  103ports_color([uncovered-[cl(_)-_]],             bisque).
  104ports_color([(exit)-_,    fail-_],             yellow).
  105ports_color([(exit)-_,    call-_],             lime).
  106ports_color([Port-_], Color) :- port_color(Port, Color).
  107
  108port_color(exception,    red).
  109port_color(exception(_), red).
  110port_color(failure,      orangered).
  111port_color(success,      greenyellow).
  112port_color(multi,        green).
  113port_color(fail,         fuchsia).
  114port_color(redo,         lightblue).
  115port_color(redoi,        cyan).
  116port_color(exit,         greenyellow).
  117port_color(call,         darkgreen).
  118% Note that exitcl and unify are converted to failure and success:
  119port_color(exitcl,       orchid).
  120port_color(unify,        orange).
  121port_color(uncovered,    white).
  122
  123ws_browser:show_source_hook(gcover, File) :-
  124    format('Content-type: text/html~n~n', []),
  125    source_to_html(File, stream(current_output),
  126                   [format_comments(true), skin(coverage_js(File))]).
  127
  128source_file_line(File, L1, L2, Scope) :-
  129    file_clause(File, Ref),
  130    source_clause_line(File, Ref, L1, L2, Scope).
  131
  132clause_id(Ref, File, CI) :-
  133    nth_clause(M:H, I, Ref),
  134    functor(H, F, A),
  135    ( module_file(M, File)
  136    ->CI = F/A-I
  137    ; CI = M:F/A-I
  138    ).
  139
  140source_clause_line(File, Ref, L1, L2, cl(CI)) :-
  141    clause_id(Ref, File, CI),
  142    clause_property(Ref, line_count(L1)),
  143    loc_file_line(clause(Ref), File, L1, L2).
  144source_clause_line(File, Ref, L1, L2, lt(TInstr)) :-
  145    '$break_pc'(Ref, PC1, _NextPC1),
  146    '$fetch_vm'(Ref, PC1, PC, TInstr),
  147    \+ skip_instr(TInstr),
  148    loc_file_line(clause_pc(Ref, PC), File, L1, L2).
  149
  150skip_instr(i_cut).
  151skip_instr(i_enter).
  152skip_instr(i_exit).
  153
  154file_clause(File, Ref) :-
  155    current_predicate(M:F/A),
  156    functor(H, F, A),
  157    \+ predicate_property(M:H, imported_from(_)),
  158    \+ predicate_property(M:H, dynamic),
  159    nth_clause(M:H, _, Ref),
  160    clause_property(Ref, file(File)).
 covered(+File, -L1, -L2, -Port, -Tag, -Count)
Get on backtracking coverage information per each line, and the Port that has been tried in the program point specified by File, L1 and L2, including uncovered which is used to detect if such code has been covered or not, in such case the Tag can be clause or literal, depending if is the clause or the literal that has not been covered. Note that could happend that a covered line does not have an 'uncovered' entry, for instance if at some late point the system was unable to get the program point.
  172covered(File, L1, L2, Port, Tag, Count) :-
  173    covered_db(File, L1, L2, Port, Tag, Count).
  174covered(File, L1, L2, uncovered, Scope, 0) :-
  175    source_file_line(File, L1, L2, Scope).
  176
  177property_lines(File, List, Tail) :-
  178    findall((L1-L2)-(Port-(Tag-Count)),
  179            covered(File, L1, L2, Port, Tag, Count),
  180            Pairs),
  181    sort(Pairs, Sorted),
  182    group_pairs_by_key(Sorted, Grouped),
  183    foldl(property_lines_each, Grouped, List, Tail).
  184
  185porttags_color(Pairs, Color) :-
  186    ports_color(Ports, Color),
  187    subset(Ports, Pairs).
  188
  189property_lines_each((L1-L2)-PortTagCL) -->
  190    { group_pairs_by_key(PortTagCL, PortTagCGU),
  191      ( subtract(PortTagCGU, [uncovered-_], PortTagCG),
  192        PortTagCG \= []
  193      ->true
  194      ; PortTagCG = PortTagCGU
  195      ),
  196      once(porttags_color(PortTagCG, Color)),
  197      findall(L, between(L1, L2, L), LineL)
  198    },
  199    foldl(line_color(Color), LineL),
  200    ['  tT["', L1, '"]="'],
  201    foldl(port_tags_text, PortTagCG),
  202    ['";\n'].
  203
  204line_color(Color, Line) --> ['  lC["', Line, '"]="', Color, '";\n'].
  205
  206port_tags_text(Port-TagCL) -->
  207    { group_pairs_by_key(TagCL, TagCG),
  208      maplist(tag_count, TagCG, TagC)
  209    },
  210    [Port, ":", TagC,"\\n"].
  211
  212tag_count(Tag-L, Tag:S) :-
  213    sum_list(L, S).
  214
  215:- public coverage_js/3.  216
  217coverage_js(File, header, Out) :-
  218    phrase(html([script([type('text/javascript')
  219                        ],
  220                        ['function updateColorLine(){\n',
  221                         '  var lC={};\n',
  222                         '  var tT={};\n',
  223                         \property_lines(File),
  224                         '  elements=document.getElementsByClassName("line-no");\n',
  225                         '  for (var i=0; i < elements.length; i++) {\n',
  226                         '    var key=elements[i].innerText.trim();\n',
  227                         '    if (typeof lC[key] !== \'undefined\') {\n',
  228                         '      elements[i].style.backgroundColor=lC[key];\n',
  229                         '    };\n',
  230                         '    if (typeof tT[key] !== \'undefined\') {\n',
  231                         '      elements[i].style.textDecoration="underline";\n',
  232                         '      elements[i].classList.add("tooltip");\n',
  233                         '      var t=document.createElement("span");\n',
  234                         '      t.classList.add("tooltiptext");\n',
  235                         '      t.classList.add("tooltiptext::after");\n',
  236                         '      t.classList.add("tooltip-right");\n',
  237                         '      var content=document.createTextNode(tT[key]);\n',
  238                         '      t.appendChild(content);\n',
  239                         '      elements[i].appendChild(t);\n',
  240                         '    }\n',
  241                         '  }\n',
  242                         '}\n'
  243                        ]),
  244                 style([],
  245                       [
  246"
  247span.directive {
  248    display: inline;
  249}
  250
  251.tooltip {
  252    position: relative;
  253    display: inline-block;
  254    border-bottom: 1px dotted #ccc;
  255    color: #006080;
  256}
  257
  258.tooltip .tooltiptext {
  259    visibility: hidden;
  260    position: absolute;
  261    //width: 120px;
  262    background-color: dimgray;
  263    color: white;
  264    text-align: center;
  265    padding: 5px 0;
  266    border-radius: 6px;
  267    z-index: 1;
  268    opacity: 0;
  269    transition: opacity 1s;
  270}
  271
  272.tooltip:hover .tooltiptext {
  273    visibility: visible;
  274    opacity: 1;
  275}
  276
  277.tooltip-right {
  278  top: -5px;
  279  left: 125%;  
  280}
  281
  282.tooltip-right::after {
  283    content: "";
  284    position: absolute;
  285    top: 50%;
  286    right: 100%;
  287    margin-top: -5px;
  288    border-width: 5px;
  289    border-style: solid;
  290    border-color: transparent #555 transparent transparent;
  291}
  292
  293.tooltip-bottom {
  294  top: 135%;
  295  left: 50%;  
  296  margin-left: -60px;
  297}
  298
  299.tooltip-bottom::after {
  300    content: "";
  301    position: absolute;
  302    bottom: 100%;
  303    left: 50%;
  304    margin-left: -5px;
  305    border-width: 5px;
  306    border-style: solid;
  307    border-color: transparent transparent #555 transparent;
  308}
  309
  310.tooltip-top {
  311  bottom: 125%;
  312  left: 50%;  
  313  margin-left: -60px;
  314}
  315
  316.tooltip-top::after {
  317    content: "";
  318    position: absolute;
  319    top: 100%;
  320    left: 50%;
  321    margin-left: -5px;
  322    border-width: 5px;
  323    border-style: solid;
  324    border-color: #555 transparent transparent transparent;
  325}
  326
  327.tooltip-left {
  328  top: -5px;
  329  bottom:auto;
  330  right: 128%;  
  331}
  332.tooltip-left::after {
  333    content: "";
  334    position: absolute;
  335    top: 50%;
  336    left: 100%;
  337    margin-top: -5px;
  338    border-width: 5px;
  339    border-style: solid;
  340    border-color: transparent transparent transparent #555;
  341}
  342"
  343                       ])
  344                ]), Tokens),
  345    print_html(Out, Tokens).
  346coverage_js(_, footer, Out) :-
  347    phrase(html(script([type('text/javascript')
  348                       ],
  349                       ['updateColorLine();'])
  350               ), Tokens),
  351    print_html(Out, Tokens)