/*  Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        J.Wielemaker@vu.nl
    WWW:           https://www.swi-prolog.org
    Copyright (c)  2006-2022, University of Amsterdam
                              VU University Amsterdam
                              SWI-Prolog Solutions b.v.
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

:- module(prolog_cover,
          [ show_coverage/1,            % :Goal
            show_coverage/2             % :Goal, +Modules
          ]).
:- autoload(library(apply), [exclude/3, maplist/2, convlist/3]).
:- autoload(library(ordsets),
            [ord_intersect/2, ord_intersection/3, ord_subtract/3]).
:- autoload(library(pairs), [group_pairs_by_key/2]).
:- autoload(library(ansi_term), [ansi_format/3]).
:- autoload(library(filesex), [directory_file_path/3, make_directory_path/1]).
:- autoload(library(lists), [append/3]).
:- autoload(library(option), [option/2, option/3]).
:- autoload(library(readutil), [read_line_to_string/2]).
:- use_module(prolog_breakpoints, []).

:- set_prolog_flag(generate_debug_info, false).

/** <module> Clause coverage analysis

The purpose of this module is to find which part of the program has been
used by a certain goal. Usage is defined   in terms of clauses for which
the _head unification_ succeeded. For each clause  we count how often it
succeeded and how often it  failed.  In   addition  we  track  all _call
sites_, creating goal-by-goal annotated clauses.

This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
hooks and collects the results, after   which  it restores the debugging
environment.  This has some limitations:

        * The performance degrades significantly (about 10 times)
        * It is not possible to use the debugger during coverage analysis
        * The cover analysis tool is currently not thread-safe.

The result is  represented  as  a   list  of  clause-references.  As the
references to clauses of dynamic predicates  cannot be guaranteed, these
are omitted from the result.

@bug    Relies heavily on SWI-Prolog internals. We have considered using
        a meta-interpreter for this purpose, but it is nearly impossible
        to do 100% complete meta-interpretation of Prolog.  Example
        problem areas include handling cuts in control-structures
        and calls from non-interpreted meta-predicates.
*/


:- meta_predicate
    show_coverage(0),
    show_coverage(0,+).

%!  show_coverage(:Goal) is semidet.
%!  show_coverage(:Goal, +Options) is semidet.
%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
%
%   Report on coverage by Goal. Goal is executed as in once/1. Options
%   processed:
%
%     - modules(+Modules)
%       Provide a detailed report on Modules. For backwards
%       compatibility this is the same as providing a list of
%       modules in the second argument.
%     - annotate(+Bool)
%       Create an annotated file for the detailed results.
%       This is implied if the `ext` or `dir` option are
%       specified.
%     - ext(+Ext)
%       Extension to use for the annotated file. Default is
%       `.cov`.
%     - dir(+Dir)
%       Dump the annotations in the given directory.  If not
%       given, the annotated files are created in the same
%       directory as the source file.   Each clause that is
%       related to a physical line in the file is annotated
%       with one of:
%
%         | ###  | Clause was never executed.                       |
%         | ++N  | Clause was entered N times and always succeeded  |
%         | --N  | Clause was entered N times and never succeeded   |
%         | +N-M | Clause has succeeded N times and failed M times  |
%         | +N*M | Clause was entered N times and succeeded M times |
%
%       All _call sites_ are annotated using the same conventions,
%       except that `---` is used to annotate subgoals that were
%       never called.
%     - line_numbers(Boolean)
%       If `true` (default), add line numbers to the annotated file.
%     - color(Boolean)
%       Controls using ANSI escape sequences to color the output
%       in the annotated source.  Default is `true`.

show_coverage(Goal) :-
    show_coverage(Goal, []).
show_coverage(Goal, Modules) :-
    maplist(atom, Modules),
    !,
    show_coverage(Goal, [modules(Modules)]).
show_coverage(Goal, Options) :-
    clean_output(Options),
    setup_call_cleanup(
        '$cov_start',
        once(Goal),
        cleanup_trace(Options)).

cleanup_trace(Options) :-
    '$cov_stop',
    covered(Succeeded, Failed),
    (   report_hook(Succeeded, Failed)
    ->  true
    ;   file_coverage(Succeeded, Failed, Options)
    ),
    '$cov_reset'.

%!  covered(-Succeeded, -Failed) is det.
%
%   Collect failed and succeeded clauses.

covered(Succeeded, Failed) :-
    findall(Cl, ('$cov_data'(clause(Cl), Enter, 0), Enter > 0), Failed0),
    findall(Cl, ('$cov_data'(clause(Cl), _, Exit), Exit > 0), Succeeded0),
    sort(Failed0, Failed),
    sort(Succeeded0, Succeeded).


                 /*******************************
                 *           REPORTING          *
                 *******************************/

%!  file_coverage(+Succeeded, +Failed, +Options) is det.
%
%   Write a report on the clauses covered   organised by file to current
%   output. Show detailed information about   the  non-coverered clauses
%   defined in the modules Modules.

file_coverage(Succeeded, Failed, Options) :-
    format('~N~n~`=t~78|~n'),
    format('~tCoverage by File~t~78|~n'),
    format('~`=t~78|~n'),
    format('~w~t~w~64|~t~w~72|~t~w~78|~n',
           ['File', 'Clauses', '%Cov', '%Fail']),
    format('~`=t~78|~n'),
    forall(source_file(File),
           file_coverage(File, Succeeded, Failed, Options)),
    format('~`=t~78|~n').

file_coverage(File, Succeeded, Failed, Options) :-
    findall(Cl, clause_source(Cl, File, _), Clauses),
    sort(Clauses, All),
    (   ord_intersect(All, Succeeded)
    ->  true
    ;   ord_intersect(All, Failed)
    ),                                  % Clauses from this file are touched
    !,
    ord_intersection(All, Failed, FailedInFile),
    ord_intersection(All, Succeeded, SucceededInFile),
    ord_subtract(All, SucceededInFile, UnCov1),
    ord_subtract(UnCov1, FailedInFile, Uncovered),

    clean_set(All, All_wo_system),
    clean_set(Uncovered, Uncovered_wo_system),
    clean_set(FailedInFile, Failed_wo_system),

    length(All_wo_system, AC),
    length(Uncovered_wo_system, UC),
    length(Failed_wo_system, FC),

    CP is 100-100*UC/AC,
    FCP is 100*FC/AC,
    summary(File, 56, SFile),
    format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]),
    (   list_details(File, Options),
        clean_set(SucceededInFile, Succeeded_wo_system),
        ord_union(Failed_wo_system, Succeeded_wo_system, Covered)
    ->  detailed_report(Uncovered_wo_system, Covered, File, Options)
    ;   true
    ).
file_coverage(_,_,_,_).

clean_set(Clauses, UserClauses) :-
    exclude(is_pldoc, Clauses, Clauses_wo_pldoc),
    exclude(is_system_clause, Clauses_wo_pldoc, UserClauses).

is_system_clause(Clause) :-
    clause_pi(Clause, Name),
    Name = system:_.

is_pldoc(Clause) :-
    clause_pi(Clause, _Module:Name2/_Arity),
    pldoc_predicate(Name2).

pldoc_predicate('$pldoc').
pldoc_predicate('$mode').
pldoc_predicate('$pred_option').
pldoc_predicate('$exported_op').        % not really PlDoc ...

summary(String, MaxLen, Summary) :-
    string_length(String, Len),
    (   Len < MaxLen
    ->  Summary = String
    ;   SLen is MaxLen - 5,
        sub_string(String, _, SLen, 0, End),
        string_concat('...', End, Summary)
    ).


%!  clause_source(+Clause, -File, -Line) is semidet.
%!  clause_source(-Clause, +File, -Line) is semidet.

clause_source(Clause, File, Line) :-
    nonvar(Clause),
    !,
    clause_property(Clause, file(File)),
    clause_property(Clause, line_count(Line)).
clause_source(Clause, File, Line) :-
    Pred = _:_,
    source_file(Pred, File),
    \+ predicate_property(Pred, multifile),
    nth_clause(Pred, _Index, Clause),
    clause_property(Clause, line_count(Line)).
clause_source(Clause, File, Line) :-
    Pred = _:_,
    predicate_property(Pred, multifile),
    nth_clause(Pred, _Index, Clause),
    clause_property(Clause, file(File)),
    clause_property(Clause, line_count(Line)).

%!  list_details(+File, +Options) is semidet.

list_details(File, Options) :-
    option(modules(Modules), Options),
    source_file_property(File, module(M)),
    memberchk(M, Modules),
    !.
list_details(File, Options) :-
    (   source_file_property(File, module(M))
    ->  module_property(M, class(user))
    ;   true     % non-module file must be user file.
    ),
    annotate_file(Options).

annotate_file(Options) :-
    (   option(annotate(true), Options)
    ;   option(dir(_), Options)
    ;   option(ext(_), Options)
    ),
    !.

%!  detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
%
%   @arg Uncovered is a list of uncovered clauses
%   @arg Covered is a list of covered clauses

detailed_report(Uncovered, Covered, File, Options):-
    annotate_file(Options),
    !,
    convlist(line_annotation(File, uncovered), Uncovered, Annot1),
    convlist(line_annotation(File, covered),   Covered,   Annot20),
    flatten(Annot20, Annot2),
    append(Annot1, Annot2, AnnotationsLen),
    pairs_keys_values(AnnotationsLen, Annotations, Lens),
    max_list(Lens, MaxLen),
    Margin is MaxLen+1,
    annotate_file(File, Annotations, [margin(Margin)|Options]).
detailed_report(Uncovered, _, File, _Options):-
    convlist(uncovered_clause_line(File), Uncovered, Pairs),
    sort(Pairs, Pairs_sorted),
    group_pairs_by_key(Pairs_sorted, Compact_pairs),
    nl,
    file_base_name(File, Base),
    format('~2|Clauses not covered from file ~p~n', [Base]),
    format('~4|Predicate ~59|Clauses at lines ~n', []),
    maplist(print_clause_line, Compact_pairs),
    nl.

line_annotation(File, uncovered, Clause, Annotation) :-
    !,
    clause_property(Clause, file(File)),
    clause_property(Clause, line_count(Line)),
    Annotation = (Line-ansi(error,###))-3.
line_annotation(File, covered, Clause, [(Line-Annot)-Len|CallSites]) :-
    clause_property(Clause, file(File)),
    clause_property(Clause, line_count(Line)),
    '$cov_data'(clause(Clause), Entered, Exited),
    counts_annotation(Entered, Exited, Annot, Len),
    findall(((CSLine-CSAnnot)-CSLen)-PC,
            clause_call_site_annotation(Clause, PC, CSLine, CSAnnot, CSLen),
            CallSitesPC),
    pairs_keys_values(CallSitesPC, CallSites, PCs),
    check_covered_call_sites(Clause, PCs).

counts_annotation(Entered, Exited, Annot, Len) :-
    (   Exited == Entered
    ->  format(string(Text), '++~D', [Entered]),
        Annot = ansi(comment, Text)
    ;   Exited == 0
    ->  format(string(Text), '--~D', [Entered]),
        Annot = ansi(warning, Text)
    ;   Exited < Entered
    ->  Failed is Entered - Exited,
        format(string(Text), '+~D-~D', [Exited, Failed]),
        Annot = ansi(comment, Text)
    ;   format(string(Text), '+~D*~D', [Entered, Exited]),
        Annot = ansi(fg(cyan), Text)
    ),
    string_length(Text, Len).

uncovered_clause_line(File, Clause, Name-Line) :-
    clause_property(Clause, file(File)),
    clause_pi(Clause, Name),
    clause_property(Clause, line_count(Line)).

%!  clause_pi(+Clause, -Name) is det.
%
%   Return the clause predicate indicator as Module:Name/Arity.

clause_pi(Clause, Name) :-
    clause(Module:Head, _, Clause),
    functor(Head,F,A),
    Name=Module:F/A.

print_clause_line((Module:Name/Arity)-Lines):-
    term_string(Module:Name, Complete_name),
    summary(Complete_name, 54, SName),
    format('~4|~w~t~59|~p~n', [SName/Arity, Lines]).


		 /*******************************
		 *     LINE LEVEL CALL SITES	*
		 *******************************/

clause_call_site_annotation(ClauseRef, NextPC, Line, Annot, Len) :-
    clause_call_site(ClauseRef, PC-NextPC, Line:_LPos),
    (   '$cov_data'(call_site(ClauseRef, NextPC, _PI), Entered, Exited)
    ->  counts_annotation(Entered, Exited, Annot, Len)
    ;   '$fetch_vm'(ClauseRef, PC, _, VMI),
        \+ no_annotate_call_site(VMI)
    ->  Annot = ansi(error, ---),
        Len = 3
    ).

no_annotate_call_site(i_enter).
no_annotate_call_site(i_exit).
no_annotate_call_site(i_cut).


clause_call_site(ClauseRef, PC-NextPC, Pos) :-
    clause_info(ClauseRef, File, TermPos, _NameOffset),
    '$break_pc'(ClauseRef, PC, NextPC),
    '$clause_term_position'(ClauseRef, NextPC, List),
    catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true),
    (   var(E)
    ->  arg(1, SubPos, A),
        file_offset_pos(File, A, Pos)
    ;   print_message(warning, coverage(clause_info(ClauseRef))),
        fail
    ).

file_offset_pos(File, A, Line:LPos) :-
    file_text(File, String),
    State = start(1, 0),
    call_nth(sub_string(String, S, _, _, "\n"), NLine),
    (   S >= A
    ->  !,
        State = start(Line, SLine),
        LPos is A-SLine
    ;   NS is S+1,
        NLine1 is NLine+1,
        nb_setarg(1, State, NLine1),
        nb_setarg(2, State, NS),
        fail
    ).

file_text(File, String) :-
    setup_call_cleanup(
        open(File, read, In),
        read_string(In, _, String),
        close(In)).

check_covered_call_sites(Clause, Reported) :-
    findall(PC, ('$cov_data'(call_site(Clause,PC,_), Enter, _), Enter > 0), Seen),
    sort(Reported, SReported),
    sort(Seen, SSeen),
    ord_subtract(SSeen, SReported, Missed),
    (   Missed == []
    ->  true
    ;   print_message(warning, coverage(unreported_call_sites(Clause, Missed)))
    ).


		 /*******************************
		 *           ANNOTATE		*
		 *******************************/

clean_output(Options) :-
    option(dir(Dir), Options),
    !,
    option(ext(Ext), Options, cov),
    format(atom(Pattern), '~w/*.~w', [Dir, Ext]),
    expand_file_name(Pattern, Files),
    maplist(delete_file, Files).
clean_output(Options) :-
    forall(source_file(File),
           clean_output(File, Options)).

clean_output(File, Options) :-
    option(ext(Ext), Options, cov),
    file_name_extension(File, Ext, CovFile),
    (   exists_file(CovFile)
    ->  E = error(_,_),
        catch(delete_file(CovFile), E,
              print_message(warning, E))
    ;   true
    ).


%!  annotate_file(+File, +Annotations, +Options) is det.
%
%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).

annotate_file(Source, Annotations, Options) :-
    option(ext(Ext), Options, cov),
    (   option(dir(Dir), Options)
    ->  file_base_name(Source, Base),
        file_name_extension(Base, Ext, CovFile),
        directory_file_path(Dir, CovFile, CovPath),
        make_directory_path(Dir)
    ;   file_name_extension(Source, Ext, CovPath)
    ),
    keysort(Annotations, SortedAnnotations),
    setup_call_cleanup(
        open(Source, read, In),
        setup_call_cleanup(
            open(CovPath, write, Out),
            annotate(In, Out, SortedAnnotations, Options),
            close(Out)),
        close(In)).

annotate(In, Out, Annotations, Options) :-
    (   option(color(true), Options, true)
    ->  set_stream(Out, tty(true))
    ;   true
    ),
    annotate(In, Out, Annotations, 0, Options).

annotate(In, Out, Annotations, LineNo0, Options) :-
    read_line_to_string(In, Line),
    (   Line == end_of_file
    ->  true
    ;   succ(LineNo0, LineNo),
        margins(LMargin, CMargin, Options),
        line_no(LineNo, Out, LMargin),
        annotations(LineNo, Out, LMargin, Annotations, Annotations1),
        format(Out, '~t~*|~s~n', [CMargin, Line]),
        annotate(In, Out, Annotations1, LineNo, Options)
    ).

annotations(Line, Out, LMargin, [Line-Annot|T0], T) :-
    !,
    write_annotation(Out, Annot),
    (   T0 = [Line-_|_]
    ->  with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])),
        annotations(Line, Out, LMargin, T0, T)
    ;   T = T0
    ).
annotations(_, _, _, Annots, Annots).

write_annotation(Out, ansi(Code, Fmt-Args)) =>
    with_output_to(Out, ansi_format(Code, Fmt, Args)).
write_annotation(Out, ansi(Code, Fmt)) =>
    with_output_to(Out, ansi_format(Code, Fmt, [])).
write_annotation(Out, Fmt-Args) =>
    format(Out, Fmt, Args).
write_annotation(Out, Fmt) =>
    format(Out, Fmt, []).

line_no(_, _, 0) :- !.
line_no(Line, Out, LMargin) :-
    with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|',
                                    [Line, LMargin])).

margins(LMargin, Margin, Options) :-
    option(line_numbers(true), Options, true),
    !,
    option(line_number_margin(LMargin), Options, 6),
    option(margin(AMargin), Options, 4),
    Margin is LMargin+AMargin.
margins(0, Margin, Options) :-
    option(margin(Margin), Options, 4).

%!  report_hook(+Succeeded, +Failed) is semidet.
%
%   This hook is called after the data   collection. It is passed a list
%   of objects that have succeeded as  well   as  a list of objects that
%   have failed.  The objects are one of
%
%     - ClauseRef
%       The specified clause
%     - call_site(ClauseRef, PC, PI)
%       A call was make in ClauseRef at the given program counter to
%       the predicate indicated by PI.

:- multifile
    report_hook/2.


		 /*******************************
		 *             MESSAGES		*
		 *******************************/

:- multifile
    prolog:message//1.

prolog:message(coverage(clause_info(ClauseRef))) -->
    [ 'Inconsistent clause info for '-[] ],
    clause_msg(ClauseRef).
prolog:message(coverage(unreported_call_sites(ClauseRef, PCList))) -->
    [ 'Failed to report call sites for '-[] ],
    clause_msg(ClauseRef),
    [ nl, '  Missed at these PC offsets: ~p'-[PCList] ].

clause_msg(ClauseRef) -->
    { clause_pi(ClauseRef, PI),
      clause_property(ClauseRef, file(File)),
      clause_property(ClauseRef, line_count(Line))
    },
    [ '~p at'-[PI], nl, '  ', url(File:Line) ].