/**
 * 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').