Prolog "report"
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(hiord)).
:- ensure_loaded(library(text/format)).
:- ensure_loaded(library(util/files)).
:- ensure_loaded(library(text/markup)).
:- ensure_loaded(library(tester/runner)).
:- ensure_loaded(library(tester/time)).
:- ensure_loaded(library(util/sequence)).
/*************************************************************/
/* Meta Interface */
/*************************************************************/
% legend_table(-Atom)
:- multifile(legend_table/1).
:- dynamic(legend_table/1).
/*************************************************************/
/* Meta Batche */
/*************************************************************/
/**
* meta_batch:
* The predicate creates the table legend.
*/
% meta_batch
meta_batch :-
retractall(legend_table(_)),
current_prolog_flag(mach_info, Mach),
assertz(legend_table(Mach)).
/****************************************************************/
/* Dump Meta */
/****************************************************************/
/**
* dump_meta(F):
* The predicate writes the meta information to the file F. An
* already existing file F is silently overwritten.
*/
% dump_meta(+Atom)
dump_meta(Name) :-
setup_once_cleanup(
open(Name, write, Stream),
sys_dump_meta(Stream),
close(Stream)).
% sys_dump_meta(+Stream)
sys_dump_meta(Stream) :-
sys_dump_indicator(legend_table/1, Stream).
/*************************************************************/
/* Report SPI */
/*************************************************************/
/**
* report_batch(D, L, O):
* The predicate succeeds in writing HTML summary and results
* pages for the tag list L into the directory D. The parameter
* O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_batch(+Atom, +List, +List)
report_batch(Dir, Tags, Opts) :-
report_begin(Dir, Opts),
report_add(Dir, Tags, Opts),
report_end(Dir, Opts).
/**
* report_begin(D, O):
* The predicate succeeds in writing a HTML prologue into the directory D.
* The parameter O is the options list. The report generator silently
* overwrites am already existing HTML page.
*/
% report_begin(+Atom, +List)
report_begin(Dir, Opts) :-
statistics(wall, Time),
decode_report_opts(Opts, v(w('',0),w('',Time),w('',''),w(0,'')),
v(w(Locale,_),w(Title,Time2),_,_)),
sys_report_begin(Dir, Title, Time2, Locale).
/**
* report_add(D, L, O):
* The predicate succeeds in appending a HTML summary entry
* and writing result pages for the tag list L into the directory D.
* The parameter O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_add(+Atom, +List, +List)
report_add(Dir, Tags, Opts) :-
decode_report_opts(Opts, v(w('',0),w('',0),w('',''),w(0,'')),
v(w(Locale,_),_,w(Root,Subtitle),w(Flags,Base))),
sys_report_add(Dir, Tags, Root, Subtitle, Flags, Locale),
atom_concat(Dir, Root, Dir2),
sys_result_batch(Dir2, Tags, Subtitle, Locale),
sys_folders_batch(Dir2, Tags, Locale),
sys_files_batch(Dir2, Tags, Base, Locale).
/**
* report_end(D, O):
* The predicate succeeds in appending a HTML epilogue into the
* directory D. The parameter O is the options list. The report
* generator silently overwrites am already existing HTML page.
*/
% report_end(+Atom, +List)
report_end(Dir, Opts) :-
decode_report_opts(Opts, v(w('',0),w('',0),w('',''),w(0,'')), _),
sys_report_end(Dir).
/*************************************************************/
/* Main Page */
/*************************************************************/
% sys_report_begin(+Atom, +Atom, +Integer, +Locale)
sys_report_begin(Dir, Title, Time, L) :-
format_atom('~w', [Dir], Dst),
ensure_directory(Dst),
format_atom('~wpackage.html', [Dir], Name),
setup_once_cleanup(
(open(Name, write, S), dom_output_new(S, T)),
(sys_begin_html(Title, 'style.css', T),
tag(T, '<h1>'),
put_message(T, report(summary,Title), L),
tag(T, '</h1>'),
tag(T, '<p>'),
get_message(report(date), L, Format, []),
atom_time(StrTime, Format, Time, [face(utc)]),
put_message(T, report(created,StrTime), L),
tag(T, '</p>')),
close(T)).
% sys_report_add(+Atom, +List, +Atom, +Atom, +Integer, +Locale)
sys_report_add(Dir, Tags, Root, Subtitle, Flags, L) :-
format_atom('~wpackage.html', [Dir], Name),
setup_once_cleanup(
(open(Name, append, S), dom_output_new(S, T)),
(ir_object_set(S, 'indent', 6),
sys_main_list(Tags, Root, Subtitle, T, L),
(Flags /\ 1 =:= 1 ->
sys_legend(Tags, T, L);
true)),
close(T)).
% sys_report_end(+Atom)
sys_report_end(Dir) :-
format_atom('~wpackage.html', [Dir], Name),
setup_once_cleanup(
(open(Name, append, S), dom_output_new(S, T)),
(ir_object_set(S, 'indent', 6),
sys_end_html(T)),
close(T)).
/*************************************************************/
/* Main Text */
/*************************************************************/
% sys_main_list(+List, +Atom, +Atom, +Stream, +Locale)
sys_main_list(Tags, Root, Subtitle, T, L) :-
tag(T, '<h3>'), put_message(T, report(results,Subtitle), L), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'),
put_message(T, report(folders), L), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_main_member(Tags, Root, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_message(T, report(total), L), tag(T, '</td>'),
(member(Tag, Tags),
result_summary(Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>').
% sys_main_member(+List, +Atom, +Stream)
sys_main_member(Tags, Root, T) :-
call_nth(runner_folder(E, _), I),
sys_zebra_row(I, T),
format_atom('~wpackage.html#~c', [Root, E], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]), put_atom(T, E), tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_suite(E, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_main_member(_, _, _).
/*************************************************************/
/* Result Page */
/*************************************************************/
% sys_result_batch(+Atom, +List, +Atom, +Locale)
sys_result_batch(Dir, Tags, Subtitle, L) :-
format_atom('~w', [Dir], Dst),
ensure_directory(Dst),
format_atom('~wpackage.html', [Dir], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html(Subtitle, '../../../styles.css', T),
tag(T, '<h1>'), put_message(T, report(results,Subtitle), L), tag(T, '</h1>'),
sys_result_list(Tags, T, L),
sys_legend(Tags, T, L),
sys_end_html(T),
close(T),
fail.
sys_result_batch(_, _, _, _).
% sys_result_list(+List, +Stream, +Locale)
sys_result_list(Tags, T, L) :-
runner_folder(E, _),
tag(T, '<h3>'), tag_format(T, '<a name="~a">', [E]), tag(T, '</a>'),
put_message(T, report(folder,E), L), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'),
put_message(T, report(files), L), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_result_member(E, Tags, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_message(T, report(total), L), tag(T, '</td>'),
(member(Tag, Tags),
result_suite(E, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_result_list(_, _, _).
% sys_result_member(+Atom, +List, +Stream)
sys_result_member(E, Tags, T) :-
call_nth(runner_file(E, D, Title), I),
sys_zebra_row(I, T),
format_atom('~c/package.html#~c', [E, D], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]),
put_atom(T, Title),
tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_tests(E, D, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_result_member(_, _, _).
/*************************************************************/
/* Folders Pages */
/*************************************************************/
% sys_folders_batch(+Atom, +List, +Locale)
sys_folders_batch(Dir, Tags, L) :-
runner_folder(E, _),
format_atom('~w~w', [Dir, E], Dst),
ensure_directory(Dst),
format_atom('~w~w/package.html', [Dir, E], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html(E, '../../../../styles.css', T),
flush_output(T),
tag(T, '<h1>'), put_message(T, report(folder,E), L), tag(T, '</h1>'),
sys_folder_list(E, Tags, T, L),
sys_legend(Tags, T, L),
sys_end_html(T),
close(T),
fail.
sys_folders_batch(_, _, _).
% sys_folder_list(+Atom, +List, +Stream, +Locale)
sys_folder_list(E, Tags, T, L) :-
runner_file(E, D, Title),
tag(T, '<h3>'), tag_format(T, '<a name="~a">', [D]), tag(T, '</a>'),
put_message(T, report(file,Title), L), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'),
put_message(T, report(predicates), L), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_folder_member(E, D, Tags, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_message(T, report(total), L), tag(T, '</td>'),
(member(Tag, Tags),
result_tests(E, D, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_folder_list(_, _, _, _).
% sys_folder_member(+Atom, +Atom, +List, +Stream)
sys_folder_member(E, D, Tags, T) :-
call_nth(runner_pred(F, N, E, D, _), I),
sys_zebra_row(I, T),
format_atom('~c.html#~c/~d', [D,F,N], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]),
write(T, F/N),
tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_pred(F, N, E, D, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_folder_member(_, _, _, _).
/*************************************************************/
/* Files Pages */
/*************************************************************/
% sys_files_batch(+Atom, +List, +Atom, +Locale)
sys_files_batch(Dir, Tags, Base, L) :-
runner_folder(E, _),
runner_file(E, D, Title),
format_atom('~w~w/~w.html', [Dir, E, D], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html(D, '../../../../styles.css', T),
tag(T, '<h1>'), put_message(T, report(file,Title), L), tag(T, '</h1>'),
sys_file_list(E, D, Tags, Base, T, L),
sys_legend(Tags, T, L),
sys_end_html(T),
close(T),
fail.
sys_files_batch(_, _, _, _).
% sys_file_list(+Atom, +Atom, +List, +Atom, +Stream, +Locale)
sys_file_list(E, D, Tags, Base, T, L) :-
runner_pred(F, N, E, D, _),
tag(T, '<h3>'), tag_format(T, '<a name="~a/~d">', [F,N]), tag(T, '</a>'),
put_message(T, report(predicate,F/N), L), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'), put_atom(T, 'Case'), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_file_member(F, N, E, D, Tags, Base, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_message(T, report(total), L), tag(T, '</td>'),
(member(Tag, Tags),
result_pred(F, N, E, D, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_file_list(_, _, _, _, _, _).
% sys_file_member(+Atom, +Integer, +Atom, +Atom, +List, +Atom, +Stream)
sys_file_member(F, N, E, D, Tags, Base, T) :-
call_nth(clause(runner_case(F, N, E, D, C), _), I),
sys_zebra_row(I, T),
file_directory_name(Base, Dir),
file_base_name(Base, Name),
format_atom('~c~c/~c~c#~c', [Dir, E, D, Name, C], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]), put_atom(T, C), tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result(F, N, E, D, C, Tag, Z),
sys_data_cell(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_file_member(_, _, _, _, _, _, _).
/*************************************************************/
/* Files Utility */
/*************************************************************/
/**
* sys_begin_html(T, C, T):
* The predicate succeeds. As a side effect it writes a HTML page
* header with title T and style sheet C to the stream T.
*/
% sys_begin_html(+Atom, +Atom, +Stream)
sys_begin_html(Title, C, T) :-
format_atom('~c', [C], H),
tag(T, '<html>'),
tag(T, '<head>'),
tag(T, '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>'),
tag(T, '<title>'), put_atom(T, Title), tag(T, '</title>'),
tag_format(T, '<link rel="stylesheet" href="~a"/>', [H]),
tag(T, '</head>'),
tag(T, '<body class="showbody">').
/**
* sys_end_html(T):
* The predicate succeeds. As a side effect it writes a HTML
* page footer to the stream T.
*/
% sys_end_html(+Stream)
sys_end_html(T) :-
tag(T, '</body>'),
tag(T, '</html>').
/*************************************************************/
/* Legend */
/*************************************************************/
/**
* sys_legend(L, T):
* The predicate succeeds. As a side effect it writes the
* table legend and the column legend for each tag in the list L,
* to the stream T.
*/
% sys_legend(+List, +Stream, +Locale)
sys_legend(Tags, T, L) :-
tag(T, '<h3>'), put_message(T, report(legend), L), tag(T, '</h3>'),
legend_table(Legend),
tag(T, '<p>'), put_atom(T, Legend), tag(T, '</p>'),
sys_legend_column(Tags, T).
% sys_legend_column(+List, +Stream)
sys_legend_column(Tags, T) :-
tag(T, '<table>'),
member(Tag, Tags),
legend_column(Tag, Legend),
tag(T, '<tr>'),
tag(T, '<td style="width: 4em">'), put_atom(T, Tag), tag(T, '</td>'),
tag(T, '<td style="width: 32em">'), put_atom(T, Legend), tag(T, '</td>'),
tag(T, '</tr>'),
fail.
sys_legend_column(_, T) :-
tag(T, '</table>').
/***************************************************************/
/* Table Styling */
/***************************************************************/
/**
* sys_zebra_row(I, T):
* The predicate succeeds. As a side effect it writes the
* start of a table row, alternating between two styles
* to the stream S.
*/
% sys_zebra_row(+Integer, +Stream)
sys_zebra_row(N, T) :-
1 =:= N mod 2, !, tag(T, '<tr class="normrow">').
sys_zebra_row(_, T) :-
tag(T, '<tr class="oddrow">').
/**
* sys_data_cell(P, T):
* The predicate succeeds. As a side effect it writes the Ok and Nok
* value of the given pair P to the stream S.
*/
% sys_data_cell(+OkNok, +Stream)
sys_data_cell(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_data_cell(A, T) :- integer(A), !,
tag(T, '<td style="text-align: right">'),
format(T, '~d', [A]),
tag(T, '</td>').
sys_data_cell(A, T) :- float(A), !,
tag(T, '<td style="text-align: right">'),
format(T, '~3f', [A]),
tag(T, '</td>').
sys_data_cell(V, _) :-
throw(error(domain_error(report_value, V),_)).
/*******************************************************************/
/* Decode Report Options */
/*******************************************************************/
% decode_report_opts(+List, +Tuple, -Tuple)
decode_report_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_report_opts([X|L], I, O) :- !,
decode_report_opt(X, I, H),
decode_report_opts(L, H, O).
decode_report_opts([], H, H) :- !.
decode_report_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% decode_report_opt(+Option, +Tuple, -Tuple)
decode_report_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_report_opt(locale(A), v(w(_,U),Y,Z,T), v(w(A,U),Y,Z,T)) :- !.
decode_report_opt(title(A), v(X,w(_,Z),T,U), v(X,w(A,Z),T,U)) :- !.
decode_report_opt(date(B), v(X,w(Y,_),T,U), v(X,w(Y,B),T,U)) :- !.
decode_report_opt(root(A), v(X,Y,w(_,Z),U), v(X,Y,w(A,Z),U)) :- !.
decode_report_opt(subtitle(B), v(X,Y,w(Z,_),U), v(X,Y,w(Z,B),U)) :- !.
decode_report_opt(legend(B), v(X,Y,Z,w(F,U)), v(X,Y,Z,w(G,U))) :- !,
sys_opt_boolean(B, 1, F, G).
decode_report_opt(chart(B), v(X,Y,Z,w(F,U)), v(X,Y,Z,w(G,U))) :- !,
sys_opt_boolean(B, 2, F, G).
decode_report_opt(tests(A), v(X,Y,Z,w(T,_)), v(X,Y,Z,w(T,A))) :- !.
decode_report_opt(O, _, _) :-
throw(error(domain_error(report_option,O),_)).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('domain_error.report_option', de, 'Reportoption erwartet, gefunden ~q.').
strings('domain_error.report_value', de, 'Reportwert erwartet, gefunden ~q.').
strings('domain_error.report_option', '', 'Report option expected, found ~q.').
strings('domain_error.report_value', '', 'Report value expected, found ~q.').
/****************************************************************/
/* Other Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('report.date', de, '%d. %b %Y').
strings('report.created', de, 'Datum: ~w').
strings('report.summary', de, 'Überblick ~w').
strings('report.results', de, 'Resultate ~w').
strings('report.folder', de, 'Verzeichnis ~w').
strings('report.file', de, 'Datei ~w').
strings('report.predicate', de, 'Prädikat ~w').
strings('report.files', de, 'Dateien').
strings('report.folders', de, 'Verzeichnisse').
strings('report.predicates', de, 'Prädikate').
strings('report.total', de, 'Gesamt').
strings('report.legend', de, 'Legende').
strings('report.date', '', '%b %d, %Y').
strings('report.created', '', 'Date: ~w').
strings('report.summary', '', 'Summary ~w').
strings('report.results', '', 'Results ~w').
strings('report.folder', '', 'Folder ~w').
strings('report.file', '', 'File ~w').
strings('report.predicate', '', 'Predicate ~w').
strings('report.files', '', 'Files').
strings('report.folders', '', 'Folders').
strings('report.predicates', '', 'Predicates').
strings('report.total', '', 'Total').
strings('report.legend', '', 'Legend').