w3c_test.pl

/*  $Id$

    Part of SWI-Prolog SGML/XML parser

    Author:  Jan Wielemaker
    E-mail:  jan@swi.psy.uva.nl
    WWW:     http://www.swi.psy.uva.nl/projects/SWI-Prolog/
    Copying: LGPL-2.  See the file COPYING or http://www.gnu.org

    Copyright (C) 1990-2002 SWI, University of Amsterdam. All rights reserved.
*/

:- module(rdf_w3c_test,
	  [ process_manifest/0,
	    process_manifest/1,
	    run_tests/0,		% run all tests
	    run/0,			% run selected test
	    show/1,			% RDF diagram for File
	    run_test/1			% run a single test
	  ]).

					% get libraries locally
:- asserta(user:file_search_path(library, '.')).

:- use_module(rdf).			% our RDF parser
:- use_module(rdf_ntriples).			% read .nt files
:- load_files([ library(pce),
		library(toolbar),
		library(pce_report),
		rdf_diagram,
		library('emacs/emacs')
	      ],
	      [ silent(true)
	      ]).

:- dynamic
	verbose/0.
%verbose.

set_verbose :-
	verbose, !.
set_verbose :-
	assert(verbose).

:- dynamic
	rdf/3.

ns(test,
   'http://www.w3.org/2000/10/rdf-tests/rdfcore/testSchema#').

local('http://www.w3.org/2000/10/rdf-tests/rdfcore/',
      'W3Ctests/').

process_manifest :-
	process_manifest('W3Ctests/Manifest.rdf').
process_manifest(Manifest) :-
	retractall(rdf(_,_,_)),
	load_rdf(Manifest, Triples),
	assert_triples(Triples).

assert_triples([]).
assert_triples([rdf(S, P, O)|T]) :-
	canonise(S, Subject),
	canonise(P, Predicate),
	canonise(O, Object),
	assert(rdf(Subject, Predicate, Object)),
	assert_triples(T).

canonise(NS:Name, N:Name) :-
	ns(N, NS), !.
canonise(Absolute, N:Name) :-
	atom(Absolute),
	ns(N, NS),
	atom_concat(NS, Name, Absolute), !.
canonise(X, X).


run_tests :-
	process_manifest,
	start_tests,
	(   rdf(About, rdf:type, test:Type),
	    \+ rdf(About, test:status, literal('OBSOLETE')),
	    test_type(Type),
%	    once(run_test(About)),		% Should not be needed
	    run_test(About),
	    fail
	;   true
	), !,
	report_results.

test_type('PositiveParserTest').
%test_type('NegativeParserTest').

run_test(Test) :-
	rdf(Test, test:inputDocument, In),
	local_file(In, InFile),
	exists_file(InFile),
	(   load_rdf(InFile, RDF,
		     [ base_uri(In),
		       expand_foreach(true)
		     ])
	->  true
	;   RDF = []
	),
	Data = [ source(InFile),
		 result(RDF),
		 norm(NT),
		 substitutions(Substitions)
	       ],
					% there may be alternative output
					% documents
	(   rdf(Test, test:outputDocument, Out),
	    local_file(Out, NTFile),
	    load_rdf_ntriples(NTFile, NT),
	    feedback('Comparing to ~w~n', [NTFile]),
	    compare_triples(RDF, NT, Substitions)
	->  test_result(pass, Test, Data)
					% if all fails, display the first
	;   rdf(Test, test:outputDocument, Out),
	    local_file(Out, NTFile),
	    load_rdf_ntriples(NTFile, NT),
	    Substitions = [],
	    test_result(fail, Test, Data)
	).


local_file(URL, File) :-
	local(URLPrefix, FilePrefix),
	atom_concat(URLPrefix, Base, URL), !,
	atom_concat(FilePrefix, Base, File).


		 /*******************************
		 *	       GUI		*
		 *******************************/

:- pce_begin_class(w3c_rdf_test_gui, frame).

initialise(F, Show:chain) :->
	send_super(F, initialise, 'W3C RDF test suite results'),
	send(F, append, new(B, browser)),
	send(B, hor_stretch, 100),
	send(B, hor_shrink, 100),
	(   send(Show, member, source)
	->  new(V, emacs_view(height := 3)),
	    send(V, name, text)
	;   true
	),
	(   send(Show, member, result)
	->  new(R, rdf_diagram),
	    send(R, name, result),
	    send(R, label, 'Result')
	;   true
	),
	(   send(Show, member, norm)
	->  new(N, rdf_diagram),
	    send(N, name, norm),
	    send(N, label, 'Norm')
	;   true
	),
	stack_windows([V,R,N], _, W),
	(   nonvar(W)
	->  send(W, right, B)
	;   true
	),
	send(new(D, tool_dialog(F)), above, B),
	send(new(report_dialog), below, B),
	send(F, fill_menu, D),
	send(F, fill_browser, B).

stack_windows([], L, L).
stack_windows([H|T], W0, W) :-
	var(H), !,
	stack_windows(T, W0, W).
stack_windows([H|T], W0, W) :-
	var(W0), !,
	stack_windows(T, H, W).
stack_windows([H|T], WL, W) :-
	send(H, below, WL),
	stack_windows(T, H, W).

fill_menu(F, D:tool_dialog) :->
	send_list(D,
		  [ append(menu_item(exit, message(F, destroy)),
			   file)
		  ]).

fill_browser(_F, B:browser) :->
	send(B, style, pass, style(colour := dark_green)),
	send(B, style, fail, style(colour := red)),
	send(B?image, recogniser,
	     handler(ms_right_down,
		     and(message(B, selection,
				 ?(B, dict_item, @event)),
			 new(or)))),
	send(B, popup, new(P, popup)),
	send(B, select_message, message(@arg1, run)),
	send_list(P, append,
		  [ menu_item(run,
			      message(@arg1, run)),
		    menu_item(edit,
			      message(@arg1, edit_test)),
		    gap,
		    menu_item(show_result,
			      message(@arg1, show_triples, result)),
		    menu_item(show_norm,
			      message(@arg1, show_triples, norm)),
		    gap,
		    menu_item(discussion,
			      message(@arg1, open_url, discussion),
			      condition :=
			      message(@arg1, has_url, discussion)),
		    menu_item(approval,
			      message(@arg1, open_url, approval),
			      condition :=
			      message(@arg1, has_url, approval)),
		    gap,
		    menu_item(copy_test_uri,
			      message(@arg1, copy_test_uri))
		  ]).


test_result(F, Result:{pass,fail}, Test:name, Data:prolog) :->
	"Test failed"::
	get(F, member, browser, B),
	(   get(B, member, Test, Item)
	->  send(Item, object, prolog(Data)),
	    send(Item, style, Result)
	;   send(B, append,
		 rdf_test_item(Test, @default, prolog(Data), Result))
	).

clear(F) :->
	get(F, member, browser, B),
	send(B, clear).

summarise(F) :->
	get(F, member, browser, Browser),
	new(Pass, number(0)),
	new(Fail, number(0)),
	send(Browser?members, for_all,
	     if(@arg1?style == pass,
		message(Pass, plus, 1),
		message(Fail, plus, 1))),
	send(F, report, status, '%d tests succeeded; %d failed',
	     Pass, Fail).

:- pce_end_class(w3c_rdf_test_gui).

:- pce_begin_class(rdf_test_item, dict_item).


edit_test(Item) :->
	"Edit input document of test"::
	get(Item, object, List),
	member(source(InFile), List),
	edit(file(InFile)).

show_triples(Item, Set:{result,norm}) :->
	"Show result of our parser"::
	get(Item, key, Test),
	get(Item, object, List),
	Term =.. [Set,Triples],
	member(Term, List),
	send(Item, show_diagram(Triples,
				string('%s for %s', Set?label_name, Test))).

show_diagram(_Item, Triples:prolog, Label:name) :->
	"Show diagram for triples"::
	new(D, rdf_diagram(Label)),
	send(new(report_dialog), below, D),
	send(D, triples, Triples),
	send(D, open).

open_url(Item, Which:name) :->
	"Open associated URL in browser"::
	get(Item, key, Test),
	rdf(Test, test:Which, URL),
	www_open_url(URL).

has_url(Item, Which:name) :->
	"Test if item has URL"::
	get(Item, key, Test),
	rdf(Test, test:Which, _URL).

run(Item) :->
	"Re-run the test"::
	get(Item, key, Test),
	run_test(Test),
	send(Item, show).

copy_test_uri(Item) :->
	"Copy URI of test to clipboard"::
	get(Item, key, Test),
	send(@display, copy, Test).

show(Item) :->
	"Show source, result and norm diagrams"::
	get(Item?image, frame, Frame),
	get(Item, object, List),
	(   get(Frame, member, result, Result)
	->  member(result(RTriples), List),
	    send(Result, triples, RTriples)
	;   true
	),
	(   get(Frame, member, norm, Norm)
	->  member(norm(NTriples), List),
	    send(Norm, triples, NTriples)
	;   true
	),
	(   get(Frame, member, text, View)
	->  member(source(File), List),
	    send(View, text_buffer, new(TB, emacs_buffer(File))),
					% scroll to RDF text
	    (   member(Pattern, [':RDF', 'RDF']),
		get(TB, find, 0, Pattern, Start),
		get(TB, scan, Start, line, 0, start, BOL)
	    ->  send(View, scroll_to, BOL, 1)
	    ;   true
	    )
	;   true
	).
%	member(substitutions(Substitutions), List),
%	send(Result, copy_layout, Norm, Substitutions),

:- pce_end_class(rdf_test_item).


:- pce_global(@rdf_test_gui, make_rdf_test_gui).

make_rdf_test_gui(Ref) :-
	send(new(Ref, w3c_rdf_test_gui(chain(source,result))), open).


test_result(Result, Test, Data) :-
	send(@rdf_test_gui, test_result, Result, Test, Data),
	(   Result == fail, verbose
	->  member(result(Our), Data),
	    length(Our, OurLength),
	    format('~N** Our Triples (~w)~n', OurLength),
	    pp(Our),
	    member(norm(Norm), Data),
	    length(Norm, NormLength),
	    format('~N** Normative Triples (~w)~n', NormLength),
	    pp(Norm)
	;   true
	).



start_tests :-
	send(@rdf_test_gui, clear).

report_results :-
	send(@rdf_test_gui, summarise).

run :-
	set_verbose,
	get(@rdf_test_gui, member, browser, B),
	get(B, selection, DI),
	get(DI, key, Test),
	run_test(Test).


		 /*******************************
		 *	     SHOW A FILE	*
		 *******************************/


show(File) :-
	rdf_diagram_from_file(File).


		 /*******************************
		 *	     COMPARING		*
		 *******************************/

%	compare_triples(+PlRDF, +NTRDF, -Substitions)
%
%	Compare two models and if they are equal, return a list of
%	PlID = NTID, mapping NodeID elements.


compare_triples(A, B, Substitutions) :-
	compare_list(A, B, [], Substitutions).

compare_list([], [], S, S).
compare_list(L1, L2, S0, S) :-
	take_bag(L1, B1, E1, R1), !,
	take_bag(L2, B2, E2, R2),
	compare_field(B1, B2, S0, S1),
	compare_bags(E1, E2, S1, S2),
	compare_list(R1, R2, S2, S).
compare_list([H1|T1], In2, S0, S) :-
	select(H2, In2, T2),
	compare_triple(H1, H2, S0, S1), % put(.), flush_output,
	compare_list(T1, T2, S1, S).

compare_triple(rdf(Subj1,P1,O1), rdf(Subj2, P2, O2), S0, S) :-
	compare_field(Subj1, Subj2, S0, S1),
	compare_field(P1, P2, S1, S2),
	compare_field(O1, O2, S2, S).

compare_field(X, X, S, S) :- !.
compare_field(literal(X), xml(X), S, S) :- !. % TBD
compare_field(rdf:Name, Atom, S, S) :-
	atom(Atom),
	rdf_parser:rdf_name_space(NS),
	atom_concat(NS, Name, Atom), !.
compare_field(NS:Name, Atom, S, S) :-
	atom(Atom),
	atom_concat(NS, Name, Atom), !.
compare_field(X, node(Id), S, S) :-
	memberchk(X=Id, S), !.
compare_field(X, node(Id), S, [X=Id|S]) :-
	\+ memberchk(X=_, S),
	atom(X),
	generated_prefix(Prefix),
	sub_atom(X, 0, _, _, Prefix), !,
	feedback('Assume ~w = ~w~n', [X, node(Id)]).

generated_prefix(Prefix) :-
	rdf_truple:anon_base(Prefix).

%	compare_bags(+Members1, +Members2, +S0, -S)
%
%	Order of _1, _2, etc. are not relevant in BadID reification. Are
%	they in general?  Anyway, we'll normalise the order of the bags

compare_bags([], [], S, S).
compare_bags([E1|T1], M, S0, S) :-
	select(E2, M, T2),
	compare_field(E1, E2, S0, S1),
	compare_bags(T1, T2, S1, S).

take_bag(Triples, Bag, Elems, RestTriples) :-
	select(rdf(Bag, Type, BagClass), Triples, T1),
	compare_field(rdf:type, Type, [], []),
	compare_field(rdf:'Bag', BagClass, [], []),
	bag_members(T1, Bag, Elems, RestTriples).

bag_members([], _, [], []).
bag_members([rdf(Bag, IsElm, E)|T], Bag, [E|ET], Rest) :-
	member_prop(IsElm), !,
	bag_members(T, Bag, ET, Rest).
bag_members([T0|T], Bag, Elems, [T0|R]) :-
	bag_members(T, Bag, Elems, R).

member_prop(rdf:Name) :-
	atom_codes(Name, [0'_|Codes]),
	number_codes(_N, Codes), !.
member_prop(Prop) :-
	atom(Prop),
	rdf_parser:rdf_name_space(NS),
	atom_concat(NS, Name, Prop),
	atom_codes(Name, [0'_|Codes]),
	number_codes(_N, Codes), !.


%	feedback(+Format, +Args)
%
%	Print if verbose

feedback(Fmt, Args) :-
	verbose, !,
	format(user_error, Fmt, Args).
feedback(_, _).