:- ensure_loaded(library('semweb/rdf_db')).

file_search_path(semwalker, '/home/sandro/semwalker').
:- ensure_loaded(semwalker(qtest)).
:- ensure_loaded(semwalker(must)).
:- ensure_loaded(semwalker(html)).
:- ensure_loaded(semwalker(short_views)).   % for label/3

rdfq(S,P,O,_) :-    % so we can cheat and use label/3
	rdf(S,P,O).

out(Subject, X) :-
	atom(Subject),
	findall(section(PropertyLabel, ValueOut),
		(   ( PropertyLabel='URI',
	              ValueOut=a(href=Subject, Subject)
		    )
		 ;  rdf(Subject, Property, Value),
		    (   label([], Property, PropertyLabel)
		    ->  true
		    ;   throw(unlabeled_property(Property))
		    ),
		    once(out(Value, ValueOut))
		),
		X).
out(literal(Value), span(Value)).
out(Subject, _) :-
	throw(out_failed(Subject)).

:- ensure_loaded(datapage_test_load).
% :- rdf_load('/home/sandro/Sandro/data-x').

r :- r(a).
r1 :- r('http://www.livejournal.com/userinfo.bml?user=sandhawke').
r2 :- r('http://www.w3.org/People/Sandro/data#sandhawke').
r3 :- r('file:///home/sandro/cvs/cvs.w3.org/WWW/2004/11/02-dawg-actions.rdf#10').

r(R) :-
	out(R,X),
	sections_to_normal_html(X, XX),
	tell('foo.html'),
	write_html(html(head([link(rel='stylesheet', href='style.css')]),
			body(XX))),
	told,
	(   shell('nso foo.html')
	->  true
	;   true
	).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


:- ensure_loaded(library('http/http_open')).
:- ensure_loaded(library(memfile)).
:- ensure_loaded(library(sgml)).



:- ensure_loaded(semwalker(qtest)).
:- ensure_loaded(semwalker(must)).

%%% debug/test

xml(N, XML) :-
	atom_number(NA, N),
	concat_atom(['sconcon_test/t', NA, '.html'], Filename),
	open(Filename, read, Stream),
	load_structure(stream(Stream), XML, [dialect(xml)]),
	close(Stream).

t(N, R) :-
	xml(N, XML),
	parse_page(XML, subject, R, []).

g(N, R) :-
	xml(N, XML),
	xml_codes2(XML, XMLCodes),
	page(R, XMLCodes, []).

page(R) -->
	[ element(html, _, Children) ],
	{ page2(R, Children, []) }.

page2([R1,R2]) -->
	optional_whitespace,
	[ element(head, _, Head) ],
	{ head(R1, Head, []) },
	optional_whitespace,
	[ element(body, _, Body) ],
	{ body(R2, Body, []) },
	optional_whitespace.

head(R) --> 
	optional_whitespace,
	[ element(title, _, Title) ],
	optional_whitespace,
	{ atom_codes(T, Title),
	  R = rdf(subject, title, literal(T)) }.

body(R) -->
	optional_whitespace,
	[ element(h1, _, MainTitle) ],
	optional_whitespace,
	[ element(p, _, _) ],
	optional_whitespace,
	{ atom_codes(T, MainTitle),
	  R = rdf(subject, maintitle, literal(T)) }.

optional(Goal, Li, Lo) :-
	true;
	call(Goal, Li, Lo).

%    there's probably a trick to threading this!
% repeated(Goal, Li, Lo) :-

		
	
% repeated	


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

parse_page(XML, Subject, R0, RX) :-
	must(zone(XML, Z)),
	must(find_usage_statement(Z, Version, Ontologies)),
	format('Match version ~a, ontologies: ~q~n', [Version, Ontologies]),
	parse_title(XML, Subject, R0, R1),
	parse_h2(XML, Subject, R1, R2),
	RX = R2.

zone(X, Z) :-
	content_match(X, element(div, Attrs, Z)),
	member(id=page, Attrs).
zone(X, Z) :-
	content_match(X, element(body, _, Z)).

%%  properties_into_URIs(+RList, -RList)
%%
%%  map from a list of   rdf(s,pl,o) to
%%                       rdf(s,pu,o)
%%
%%  where pl is a Property Label
%%  and pu is a Property URI
%%
%%  This is done by looking in the given ontology for
%%  properties that have the given label.  Strictly,
%%  it should use a subproperty of rdfs:label which
%%  is an owl:InverseFunctionalProperty, so there's
%%  no guesswork involved.   If we find some other
%%  subproperty of rdfs:label, we should maybe use it
%%  and issue a warning (which includes the text that
%%  should go into the ontology.
%%
%%  how do the ontologies get identify in sconcon 0.1?
%%
%%  <p>This page conforms to sconcon 

parse_title(_, _Subject, R0, R0).

parse_h2(XML, Subject, L, LL) :-
	findall( rdf(Subject, Property, Value),
		 (   content_match_full(XML, [element(h2, _, [Title]) | Rest]),
		     (  append(Text, [element(End,_,_)|_], Rest),
			(End=h2;End=hr;End=h1;End=author)
		     -> true
		     ;  Text = Rest ),
		     value(Text, Value),
		     property(Title, Property)
		 ),
		 Ls),
	append(Ls, LL, L).

property(X,X).
value(V,V).


%%
%%  The usage statement is a top-level paragraph starting with
%%  the text "This page uses", and containing links.  The first
%%  link must be to a sconcon version page; the later links are
%%  all taken as links to ontologies.
%%
%%  The ontology links may each be to either an OWL ontology
%%  *or* an HTML page about the ontology.   That should work.
%%
usage_message -->
	optional_whitespace, "this page uses ".

find_usage_statement(XML, Version, Ontologies) :-
	top_level_element(XML, element(p, _, P)),
	text_prefix_match(P, usage_message),
	findall(link(Link, Label),
		(   content_match(P, element(a, Attrs, Label)),
		    member(href=Link, Attrs)
		),
		Links),
	Links = [ link(VersionURI,_VersionLabel) | Ontologies ],
	(  version_uri(Version, VersionURI)
	-> true
	;  throw(unknown_format_uri(VersionURI))
	).

version_uri(v01, 'http://www.w3.org/2006/02/26/datapage-conventions').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

optional_whitespace -->
          ""
        ; whitespace_character, optional_whitespace.

whitespace -->
          whitespace_character
        ; whitespace_character, optional_whitespace.

whitespace_character -->
	[D], { number(D), code_type(D, space) }.

xwhitespace_character([32|T], T).
xwhitespace_character([10|T], T).
xwhitespace_character([9|T], T).

qtest(optional_whitespace("", "")).
qtest(optional_whitespace(" ", "")).
qtest(optional_whitespace("\n", "")).
qtest(optional_whitespace("\t\t\t  \n\n  \t ", "")).

text_prefix_match(XML, Goal) :-
	xml_codes(XML, Codes),
	call(Goal, Codes, _).

xml_codes([], []).
xml_codes([H|T], Codes) :-
	(  atom(H),
	   downcase_atom(H,DH)    % do we always want this?  yes for now.
	-> atom_codes(DH, AtomCodes)
	;  must(H=element(_Tag, _Attr, Children)),
	   xml_codes(Children, AtomCodes)
	),
	xml_codes(T, Rest),
	append(AtomCodes, Rest, Codes).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

scrape_data_page(Doc, DataPage, _Date) :-
	wiki_content(DataPage, TopContent),
	Doc=doc(DataPage, TopContent).

doc(doc(_, XML), title, Value) :-
	content_match(XML, element(h2, _, Value)).

doc(doc(_, XML), editors, Value) :-
	findall(XX,
		(
		content_match(XML, [element(dt, _, ['Editor']), '\n',
				    element(dd, _,
					    [ element(p, _, X), '\n' ]
					   )
				   ]),
		  once(html:sgml_compact(X, XX))
		),
		Value).

doc(doc(_, XML), toc, Value) :-
	glean_toc(XML, Value).

doc(doc(URI, _), uri_prefix, Value) :-
	atom_concat(URI, '/', Value).

doc(doc(_, XML), abstract, Value) :-
	Key='Abstract',
	once((content_match(XML, [element(h3, _, [Key]) | Rest]),
	      append(Text, [element(h3,_,_)|_], Rest))),
	internalize_text(x, Text, Value).

/*
doc(doc(_, XML), status, Value) :-
	(Key='Status of this Document' ; Key='Status Of This Document'),
	content_match(TopContent, [element(h3, _, [Key]) | Rest]),
	append(Text, [element(h3,_,_)|_], Rest),
	internalize_text(Doc, Text, TextH),
*/

doc(doc(_, XML), Property, Value) :-
	property_label(PropertyLabel, Property),
	match_dtdd(XML, PropertyLabel, V1),
	internalize_text(x, V1, Value).

doc(Doc, className, Value) :-
	doc(Doc, classAbbr, A),
	document_class_name(A, Value).

doc(Doc, classAbbr, Value) :-
	doc(Doc, classAbbrText, T),
	T = [Value].

xxdoc(_, P, _) :-
	format(user_error, 'doc failed ~q~n', [P]),
	fail.


document_class_name('ED', 'Editor\'s Draft').
document_class_name('WD', 'Working Draft').
document_class_name('LC', 'Last Call Working Draft').
document_class_name('CR', 'Candidate Recommendation').
document_class_name('PR', 'Proposed Recommendation').
document_class_name('REC', 'Recommendation').

property_label('Publication Date', pubDate).
property_label('Comments Due By', commentDate).
property_label('Request For Comments', callForComments).
property_label('Document Class Code', classAbbrText).
property_label('Status Notes', otherStatus).
property_label('Editor', editor).
property_label('This Version', thisVersion).
property_label('Latest Version', latestVersion).
property_label('Previous Version', previousVersion).

%  match_dl(XML, DT, DD)
match_dtdd(XML, DT, Value) :-
	once(
	  content_match(XML, [element(dt, _, [DT]), '\n',
		   	    element(dd, _,
				    [ element(p, _, [element(a, [href=X], _)|_]) | _]
)])
	    ;
	       content_match(XML, [element(dt, _, [DT]), '\n',
			    element(dd, _,
				    [ element(p, _, X), '\n' ]
				   )
			   ])
	),
	(   [Y] = X,
	    atom(Y),
	    atom_concat(Trimmed, ' ', Y)
	->  Value = [Trimmed]
	;   Value = X
	).


%%
%%  glean_toc(+XML, -Table)
%%
%%  pull out the Table of Contents section and turn it into
%%      [ section(tag, title, [subsections]), ... ]
%%

glean_toc(TopContent, TOC) :-
	content_match(TopContent, [element(h3, _, ['Table Of Contents']) | Rest]),
	(  append(Text, [element(h3,_,_)|_], Rest)
	;  Text = Rest ),
	!,
	whiteless(Text, CleanText),
	content_list(CleanText, TOC), !.

% remove the annoying noise in XML!
whiteless(Dirty, Clean) :-
	(   Dirty = [ Head | Tail ]
	->  (   white(Head)
	    ->  whiteless(Tail, Clean)
	    ;   whiteless(Head, CleanHead),
		whiteless(Tail, CleanTail),
		Clean = [CleanHead | CleanTail]
	    )
	;   (   Dirty = element(Tag, Attrs, List)
	    ->  whiteless(List, CleanList),
		Clean = element(Tag, Attrs, CleanList)
	    ;   Clean = Dirty
	    )
	).

white(' ').
white('\n').
white('\n\n').

/*
  whiteless([' ', q(3), '\n', [ '\n\n', x, [ ' ', p=p ], ' ', y ] ], X).
  */


content_list([], []).
content_list([element(ol, _, LIs),
	      element(a, [id=bottom], [])
	     ], Entries) :-
	(  li_entry(LIs, Entries)
	-> true
	;  throw(li_failed(LIs))
	).
content_list([element(ol, _, LIs)]
	    , Entries) :-
	(  li_entry(LIs, Entries)
	-> true
	;  throw(li_failed(LIs))
	).
content_list(X, _) :-
	format(' bad content list: ~q\n ', [X]).

%

li_entry([], []).
li_entry([H|T], [section(Label, Name, SubsS)|TT]) :-
	(   H = element(li, [], [element(p, [],
					 [element(a, Attrs, [Text])]
					)
				| Subs])
	->  atom_concat('/', Name, Text),
	    member(href=URI, Attrs),
	    concat_atom(Parts, '/', URI),
	    last(Parts, Label)
	;   format(' bad li: ~q\n ', [H]),
	    format(' T: ~q\n ', [T]),
	    Name=skipped,
	    Subs=[]
	),
	!,
	%format('  got li: ~q, subs: ~q\n ', [Name, Subs]),
	content_list(Subs, SubsS),
	!,
	%format('  got li2: ~q, subs: ~q\n ', [Name, Subs]),
	li_entry(T, TT).
	%!,
	%format('  got li3: ~q, subs: ~q\n ', [Name, Subs]).
%li_entry(Failed, _) :-
%	format(' li failed: ~q\n ', [Failed]).
	






content_match_full(Tree, Tree).
content_match_full(element(_Tag, _Attrs, Kids), SubTree) :-
        content_match_full(Kids, SubTree).
content_match_full([H|T], SubTree) :-
        (   content_match_full(H, SubTree)
        ;   content_match_full(T, SubTree)
        ).

content_match(Tree, Tree).
content_match(element(_Tag, _Attrs, Kids), SubTree) :-
        content_match(Kids, SubTree).
content_match(Tree, SubTree) :-
	append(SubTree, _, Tree).
content_match([H|T], SubTree) :-
        (   content_match(H, SubTree)
        ;   content_match(T, SubTree)
        ).

content_match(Tree, Tree, 0).
%content_match(element(li, _Attrs, Kids), SubTree) :-
%        content_match(Kids, SubTree).
content_match(element(_Tag, _Attrs, Kids), SubTree, N) :-
        content_match(Kids, SubTree, N1),
	N is N1 + 1.
content_match([H|T], SubTree, N) :-
        (   content_match(H, SubTree, N)
        ;   content_match(T, SubTree, N)
        ).


uri(Doc, Tag, URI) :-
	doc(Doc, uri_prefix, Prefix),
	concat_atom([Prefix, Tag], URI).


page_text(Doc, Tag, Shift, URI, H) :-
	format(user_error, 'retreiving 1 ~q...\n', [Tag]),
	uri(Doc, Tag, URI),
	format(user_error, 'retreiving 2 ~q...\n', [Tag]),
	wiki_content(URI, SgmlText),
	format(user_error, 'retreiving 3 ~q...\n', [Tag]),
	mapxml(shift_heading_rank(Shift), SgmlText, SgmlText2),
	internalize_text(Doc, SgmlText2, H),
	format(user_error, 'Done retreiving ~q...\n', [Tag]).


% this is really NOT something we want.  Ah well....
shift_heading_rank(Amt, T, T1) :-
	(   T = element(Tag, Attrs, Kids),
	    atom_concat('h', NA, Tag),
	    atom_number(NA, N)
	->  New is N + Amt,
	    (   New < 1
	    ->  N1 = 1
	    ;   N1 = New
	    ),
	    (   N1 > 6
	    ->  N2 = 6
	    ;   N2 = N1
	    ),
	    atom_number(NA2, N2),
	    atom_concat('h', NA2, Tag1),
	    T1 = element(Tag1, Attrs, Kids)
	;   T1 = T
	).

mapxml(F, T, T1) :-
	(   T = [Head | Tail]
	->  mapxml(F, Head, Head1),
	    mapxml(F, Tail, Tail1),
	    T1 = [Head1 | Tail1]
	;   (   T = element(Tag, Attrs, Kids)
            ->  mapxml(F, Kids, KidsX),
		TX = element(Tag, Attrs, KidsX),
		call(F, TX, T1)
	    ;   call(F, T, T1)
	    )
	).


qtest :-
	mapxml(=,
	       [a,b,c,element(x,y,[a,b])],
	       [a,b,c,element(x,y,[a,b])]
	      ).

qtest :-
	mapxml(shift_heading_rank(3),
	       [element(h1, [], was_h1),
		element(h2, [], was_h2),
		element(h3, [], was_h3),
		element(h4, [], was_h4),
		element(h5, [], was_h5),
		element(h6, [], was_h6)],
	       X),
	X = [element(h4, [], was_h1),
	     element(h5, [], was_h2),
	     element(h6, [], was_h3),
	     element(h6, [], was_h4),
	     element(h6, [], was_h5),
	     element(h6, [], was_h6)]
	.


clean_attrs(Pred, T, T1) :-
	(   T = element(Tag, Attrs, Kids)
	->  sublist(Pred, Attrs, Attrs1),
	    (   Attrs1 = [],
		Tag = a
	    ->  T1 = element(span, [], [])
	    ;   T1 = element(Tag, Attrs1, Kids)
	    )
	;   T = T1
	).

id_okay(A) :-
	(   A = (id=ID),
	    bad_id(ID)
	->  fail
	;   true
	).

bad_id(content).
bad_id(top).
bad_id(bottom).

qtest :-
	mapxml(clean_attrs(id_okay),
	       [element(div, [a=a,b=b,id=content,id=bottom,c],
			[ element(div, [a=a,b=x,id=content,id=bottom,c],
				  [ element(div, [a,b=p,id=content,id=bottom,c],
					    [ hello ])
				  ])
			])],
	       X),
	X = [element(div, [a=a, b=b, c], [element(div, [a=a, b=x, c], [element(div, [a, b=p, c], [hello])])])].
	

%%  internalize_text(?Doc, +In, -Out)
%%
%%  Transform some page XML (already narrowed to the chunk we want) into
%%  our internal HTML structure, while doing some re-writing of things like
%%  "id" attributes, and making proper links to References.
%%

internalize_text(_Doc, In, Out) :-
	% option(refs(Refs), Doc, _),
	once(mapxml(clean_attrs(id_okay), In, In2)),
	html:sgml_compact(In2, Out).


wiki_content(Page, Out) :-
	atom_concat(Page, '?action=content', URI),
	(   aserved(URI, stream(Stream), _Seconds, _Bytes, [])
	->  load_structure(stream(Stream),
		       Structure,
		       [dialect(xml)]),
	    Out=[element(div, _, Structure)]
	;   Out = [element(p, [style='color:red; font-size: 200%;'], ['Content Retrieval Failed on ', URI])],
	    format(user_error, 'Failed on ~q\n', [URI])
	).


		   
aserved(Address, Content, Seconds, Bytes, Options) :-
        get_time(Start),
        http_open(Address, Stream, Options),
        (   Content = stream(Stream)
        ->  true
        ;   new_memory_file(F),
            open_memory_file(F, write, MemStream),
            copy_stream_data(Stream, MemStream),
            close(Stream),
            close(MemStream),
            size_memory_file(F, Bytes),
            memory_file_convert(F, Content)
        ),
        get_time(Stop),
        Seconds is Stop - Start.

memory_file_convert(M, atom(A)) :-
        memory_file_to_atom(M, A),
        free_memory_file(M).
memory_file_convert(M, codes(C)) :-
        memory_file_to_codes(M, C),
        free_memory_file(M).
memory_file_convert(M, memory_file(M)).   % you free it, of course.




%%  match_through(XML, Match, ThroughTags)
%%
%%  Unify Match with each member of the XML list, and recursively
%%  with each child list if the tag on the child list is one of
%%  ThroughTags.

match_through(XML, Match, _ThroughTags) :-
	member(Match, XML).
match_through(XML, Match, ThroughTags) :-
	member(element(Tag, _, Children), XML),
	member(Tag, ThroughTags),
	match_through(Children, Match, ThroughTags).

top_level_element(XML, Element) :-
	match_through(XML, Element, [div, span]).



xml_codes2([], []).
xml_codes2([H|T], Codes) :-
	xml_codes2(T, Rest),
	(  atom(H)
	-> atom_codes(H, HeadCodes),
	   append(HeadCodes, Rest, Codes)
	;  must(H=element(Tag, Attr, Children)),
	   xml_codes2(Children, ChildrenCodes),
	   Codes = [ element(Tag, Attr, ChildrenCodes) | Rest ]
	).


