%%% File:     ixwrap.pl
%%% Author:   Stephen Potter <stephenp@gairsay.aiai.ed.ac.uk>
%%% Created:  Thur 13 June 2002

%%% code to act as a comms wrapper for a prolog program to 
%%% enable it to interact with I-X. 

%:- module(ixwrap,
%	[ix_receive_loop/2,
%	ix_receive/3,
%	ix_send/3,
%	ix_send/4]).

:-use_module('kraft/prolog/pillow/pillow.pl').
:-use_module('aktbus-0.3.1/prolog/src/absl').
%:-use_module(library('linda/client')).
:-use_module(library(lists)).
:-use_module(library(sockets)).
:-use_module(library(charsio)).

% location of broker (actually: gatekeeper).
broker('http://cara.aiai.ed.ac.uk:7000'). % will need to change this!
hostname("http://cara.aiai.ed.ac.uk:").
%agentname('KRAFT').


test(C):-
	catch(call(C),existence_error(_,_,_,_,_),(write('unknown'))).

	
recipient('http://oronsay.aiai.ed.ac.uk:5060'). % IX ITEST

% Port is the port of the socket to be opened on the agent host
% to accept the broker's response.
% Query is assumed to some atom or predicate.

commtest(RPort,SPort) :-
	%register_ix_agent(RPort,'PrologAgent'),
	ix_receive(RPort,Message,Sender),
	catch(call(Message),existence_error(_,_,_,_,_),
	                       (format("\nFailure: existence error!\n",[]))),
	%(call(Message);true),
	%recipient(R),
	ix_send(SPort,Sender,Message).

register_ix_agent(RPort,Name):-
	% RPort number, Name atom.
	broker(BURI),
	hostname(HN),
	name(RPort,PS),
	append(HN,PS,AU1),
	append("'",AU1,AU2),
	append(AU2,"'",AU),
	name(AgentURI,AU),
	name(AUA,AU1),
	name(Name,NameS),
	append("\'",NameS,NS1),
	append(NS1,"\'",NS2),
	name(AgentName,NS2),
%	write_to_chars(solver(AgentURI,prolog,[c('\'PrologA\'',[],[],[])]),QC),
	write_to_chars(solver(AgentURI,prolog,[c(AgentName,[],[],[])]),QC),
	compose_message(AUA,BURI,QC,Msg),
	send_message(Msg).
	

% ix_receive_loop(+Port,+SPort) opens a port Port on the current
% machine and repeatedly awaits I-X messages containing Prolog terms, 
% responding to the sender (using port SPort) of each with the result 
% of calling the Prolog.
% The service is killed when the atom 'close_connection' is received.
ix_receive_loop(Port,SPort,Name) :-
	create_aktbus_receiver(Port,RHandle),
	register_ix_agent(Port,Name),
	format("Port ~d opened\n", [Port]),
	ix_get_msg_loop(RHandle,SPort),
	!,
	destroy_aktbus_receiver(RHandle).

ix_receive_loop(Port,SPort):-
	ix_receive_loop(Port,SPort,'PrologAgent').

% ix_receive(+Port,-Message,-Sender,+Name) opens a port Port and awaits
% an IX Message from Sender.
ix_receive(Port,Message,Sender,Name) :-
	create_aktbus_receiver(Port,RHandle),
	register_ix_agent(Port,Name),
	format("Port ~d opened\n", [Port]),
	ix_get_message(RHandle,Message,Sender),
	!,
	destroy_aktbus_receiver(RHandle).

ix_receive(Port,Message,Sender):-
	ix_receive(Port,Message,Sender,'KRAFT').

check_terminated(Term,Term):-
        append(_X,".",Term).
check_terminated(Term,TermT):-
        \+append(_X,".",Term),
        append(Term,".",TermT).

ix_get_message(RHandle,Message,SenderURI):-
	format("Waiting for message\n",[]),
	receive_message(RHandle,Msg),
	write(Msg),nl,
%	get_env(Msg, 'aktbus:hasContent',_,[Content|_]),
	get_env(Msg, 'aktbus:hasSimpleMessage',_,[IXMessage|_]),
	get_env(Msg, 'aktbus:hasSenderURI',_,[SenderURI|_]),
	get_env(Msg, 'aktbus:hasDateString',_,[_Date|_]),
	get_env(Msg, 'aktbus:hasTimeString',_,[_Time|_]),

	%parse_ix_xml(Sender,Content,IXMessage,[]),
	
	write(SenderURI),nl,

	name(IXMessage,IXTemp),
	clean_parse(IXT,IXTemp,[]),!,
	xml2terms(IXT,IXM),
	%name(IXM,IXT),
	write(IXM),nl,
%	write(IXMessage),nl,

	% IXMessage is now xml, so this should do it:
	%get_env(IXM,'statement',_,[Content|_]),
	get_mcontent(IXM,Content,_Type),

	% assume Content is a quoted string...(!)
	% the following is a bit of a fix...
	write(Content),

	((atom_concat('"',C1,Content),
	atom_concat(Cont,'"',C1),
	%format("Received ~a from ~a\n", [Sender,Content]),
	name(Cont, TC1),
        check_terminated(TC1,TC),
	%append(TC1,".",TC), % need to append full stop!
	nl,write(TC),nl,
	read_from_chars(TC,Message));

	Message=Content).


% note: this definition of issue content is not complete...
get_mcontent(IXM,Content,symbol):-
	get_env(IXM,'symbol',_,[Content|_]).
get_mcontent(IXM,Content,string):-
	get_env(IXM,'string',_,[Content|_]).
get_mcontent(IXM,Content,item-var):-
	get_env(IXM,'item-var',_,[Content|_]).
%get_mcontent(IXM,Content,integer):-
%	get_env(IXM,'integer',_,[Content|_]).
get_mcontent(IXM,Content,long):-
	get_env(IXM,'long',_,[Content|_]).
% if 'list' then recursive...
get_mcontent(IXM,Content,list):-
	get_env(IXM,'list',_,[Content|_]).

ix_get_msg_loop(RHandle,RPort):-
	format("Waiting for message\n",[]),
	receive_message(RHandle,Msg),
	write(Msg),nl,
%	get_env(Msg, 'aktbus:hasContent',_,[Content|_]),
	get_env(Msg, 'aktbus:hasSimpleMessage',_,[IXMessage|_]),
	get_env(Msg, 'aktbus:hasSenderURI',_,[SenderURI|_]),
	get_env(Msg, 'aktbus:hasDateString',_,[_Date|_]),
	get_env(Msg, 'aktbus:hasTimeString',_,[_Time|_]),

	%parse_ix_xml(Sender,Content,IXMessage,[]),
	
	write(SenderURI),nl,
	
	name(IXMessage,IXTemp),
	clean_parse(IXT,IXTemp,[]),!,
	xml2terms(IXT,IXM),
	%name(IXM,IXT),
	write(IXM),nl,

	% IXMessage is itself xml, so this should do it:
	% (What will the content from IX look like?)
	% get_env(IXM,'statement',_,[Content|_]),
	%get_env(IXM,'string',_,[Content|_]),
	
	get_mcontent(IXM,Content,Type),
	% assume Content is a quoted string...(!)
	% the following is a bit of a fix...

	write(Content),
   
	((%atom_concat('"',C1,Content),
	%atom_concat(Cont,'"',C1),
	%format("Received ~a from ~a\n", [Sender,Content]),
	name(Content, TC1),
        check_terminated(TC1,TC),
	%append(TC1,".",TC), % need to append full stop!
	nl,write(TC),nl,
	read_from_chars(TC,C));

	C=Content),

	%C=ok,
	write(C),nl,

	(
	    (C=close_connection, % reserved atom kills service!
	    format("Connection closed\n",[])
	    );
	    (
	    %----------------------------------------%
	    %------- insert prolog call here! -------%
	    %----------------------------------------%

	    ((callable(C),
	    catch(call(C),existence_error(_,_,_,_,_),(format("\nFailure: existence error!\n",[]))));
	    true),
	    %(call(C);true),
	    ix_send(RPort,SenderURI,C,none,Type), % & send reply
	    format("IX-Message processed.\n",[]),
	    ix_get_msg_loop(RHandle,RPort))
	).


% ix_send(+Port,+IXReceiverURI,+Term) sends the Prolog Term to 
% the URI IXReceiverURI via port Port on the local host:
%ix_send(9876,'http://oronsay.aiai.ed.ac.uk:5060',f(x,y)).


ix_send(Port,IXReceiverURI,Term):-
	ix_send(Port,IXReceiverURI,Term,none,string).

ix_send(Port,IXReceiverURI,Term,Priority,Type):-
	% open connection for response: do this first to ensure
	% that (a) port is valid and (b) port will be open by the
	% time that the response is generated!

	current_host(X),
	name(X,H),
	append("http://",H,H1),
	append(H1,":",Agent),

	name(Port,P),
	append(Agent,P,AU),
	name(AUA,AU),

	%name(Query,Q),
	%ser(Query,Cont),
	%make_content(Query,Cont),
	%compose_message(AU,Broker,Cont,Msg),


	write_to_chars(Term,TChars), % convert Term (may be compound) to chars
	name(TAtom,TChars), % convert chars to single atom
	generate_xml(AUA,TAtom,Priority,Type,XMLS,[]), % place atom within xml
	
	%name(XMLT,XMLS),
	% not sure I need this yet:
	%quote_atoms(XMLT,EQ),
	%write_to_chars(XMLT,CQ),
	%escape_specials(CQ,ECQ,[]),
	
	compose_message(AU,IXReceiverURI,XMLS,Msg),
	write(Msg),
	send_message(Msg).

clean_parse(Cleaned) --> "&quot;", clean_parse(R), {append("\"",R,Cleaned)}.
clean_parse(Cleaned) --> "&apos;", clean_parse(R), {append("\'",R,Cleaned)}.
clean_parse(Cleaned) --> "&lt;", clean_parse(R),{append("<",R,Cleaned)}.
clean_parse(Cleaned) --> "&gt;", clean_parse(R),{append(">",R,Cleaned)}.
%clean_parse(">") --> "&gt;".
%clean_parse([C]) --> [C].
clean_parse("") --> "".
clean_parse(Cleaned) --> [C], clean_parse(R), {append([C],R,Cleaned)}.



quote_atoms(Q,Q):-
	(var(Q);number(Q)).
quote_atoms(Q,E):-
	atom(Q),
	esc([Q],[E]).
quote_atoms((A,B),(E1,E2)):-
	quote_atoms(A,E1),
	quote_atoms(B,E2).
quote_atoms(Query,EQ):-
	nonvar(Query),
	Query =..[F|Args],
	esc(Args,AL),
	EQ =..[F|AL].

esc([],[]).
esc([A|R],[N|AT]):-
	nonvar(A),
	\+atom(A),
	A =..[F|Args],
	esc(Args,AL),
	N =..[F|AL],
	esc(R,AT).
esc([A|R],[N|AT]):-
	nonvar(A),
	name(A,AS),
	append("\'",AS,T1),
	append(T1,"\'",T2),
	name(N,T2),
	esc(R,AT).
esc([A|R],[A|T]):-
	(var(A);number(A)),
	esc(R,T).


escape_specials([]) --> "".
escape_specials([46|T]) -->
	"\\.",
	escape_specials(T).
escape_specials([X|T]) -->
	[X],
	escape_specials(T).

generate_xml(Content,S,R):-
	generate_xml(me,Content,none,string,S,R).
generate_xml(Sender,Content,S,R):-
	generate_xml(Sender,Content,none,string,S,R).

generate_xml(Sender,Content,Priority,Type) --> 
	{atomic(Content),name(Content,Con),name(Sender,Sen)},
	"\<issue sender-id=\"",Sen,"\"\>",priority(Priority),"\<pattern\>\<list\>",mcont(Con,Type),"\</list\>\</pattern\>\</issue\>".


mcont(Con,string) --> "\<string\>",Con,"\</string\>".
mcont(Con,symbol) --> "\<symbol\>",Con,"\</symbol\>".
mcont(Con,item-var) --> "\<item-var\>",Con,"\</item-var\>".
%mcont(Con,integer) --> "\<integer\>",Con,"\</integer\>".
mcont(Con,long) --> "\<long\>",Con,"\</long\>".

priority(none) --> "".
priority(Priority) --> 
	{name(Priority,P)},
	"\<priority\>",P,"\</priority\>".


parse_ix_xml(Sender,Content) --> "<issue sender-id=\"",content(Sender),"\">, priority, <statement>", content(Content), "</statement></issue>".

priority --> "".
priority --> "<priority>", content(_Priority), "</priority>".
content(S) --> 
	[C], 
	{name(X,[C]),
	((number(X),lookupn(X,S));(\+number(X),S=X))}.
content(S) --> 
	content(P),[C], 
	{name(X,[C]), 
	((number(X),lookupn(X,T));(\+number(X),T=X)),
	atom_concat(P,T,S)}.
	
	


serialise(Content, Terms):-
	var(Terms),
	!,
	xmls(Content,Terms,[]),
	%writeq(Terms).
	format(Terms,[]).

serialise(Content,Terms):-
	parse_sxml(Content,Terms,[]).
/*
ser(Content,Terms1):-
	var(Terms1),
	!,
	numbervars(Term,0,_),
	xmyp1(Content,Terms,[]),
	format(Terms,[]),
	Terms1 = Terms.
	%name(Terms1,Terms).
ser(Content,Terms):-
	xmypr1(Content,Terms,[]).
*/

xmls([]).
xmls([H]) -->
	!,
	xmls(H).
xmls([H|T]) -->
	!,
	
	xmls(H),",",
	xmls(T).



xmls(X) -->
	{var(X)},
	!,
	"[env(var,[],[])]".

xmls(X) -->
	{atomic(X),name(X,N)},
	!,
	"[env(atom,[],",N,")]".

xmls((X,Y)) -->
	!,
	xmls(X),",",
	xmls(Y).

xmls([X|_T]) -->
	{X =.. ['.',A|Args],xmls(A,H,[]),xmls(Args,As,[])},
	!,
	"[env(.,[],[env(.,[],[",H,",",As,")]])])]".

xmls(X) -->
	{X =.. [H|Args],name(H,N),xmls(H,_Fun,[]),xmls(Args,As,[])},
	!,
	"[env(term,[],[env(",N,",[],[",As,"])])]".

xmls((A:-B)) -->
	{xmls(A,L1,[]),xmls(B,L2,[])},
	!,
	%xmls(A),",",
	"[env(':-',[],[",L1,",",L2,"])]".


myp1(X) -->
	"env(prolog,[],[", myp(X), "])".

myp([]).
myp(X) -->
	{atom(X),name(X,N)},
	!,
	"<atom>",
	N,
	"</atom>".
myp(X) -->
	{var(X),atom_concat('V',X,VN),name(VN,N)},
	!,
	"<var>",
	N,
	"</var>".

myp([H])-->
	!,
	myp(H).

myp([H|T]) -->
	!,
	"[.,",
	myp(H),
	",",
	myp(T),
	"]".

myp(arg([])) --> "".
myp(arg([H|T])) -->
	!,
	"<arg>",myp(H),
	"</arg>",
	myp(arg(T)).

myp(X) -->
	{X =.. [F|Args],
	name(F,FN)},
	!,
	"<pred>",FN,
	myp(arg(Args)),
	"</pred>".


mypr1(X) --> "env(prolog,[],[",mypr(X),"])".

mypr(X) --> "<pred>", atomey(F), {\+end_tag(F)}, mypr(arg(A)), "</pred>", {append([F],A,FL),X=..FL}.
mypr(arg(A)) --> "<arg>", mypr(Arg), "</arg>", mypr(arg(Z)), {append([Arg],Z,A)}.
mypr(arg([])) --> "". 
mypr(X) --> "<atom>", atomey(X), "</atom>".
mypr(X) --> "<var>", atomey(X), "</var>".


atomey(Z) --> [C], {name(Z,[C])}.
atomey(Z) --> %[C], {\+[C]="<"}, 
	atomey(D), [C], {name(H,[C]), atom_concat(D,H,Z)}.
%atomey(Z) --> [C], {name(Z,[C]), \+Z='<'}.
atomey('') --> "".

end_tag(Z) :- 
	name(Z,N),
	append(B,_C,N),
	append(_A,"</",B).

mypro(Z) --> "[.,", mypr(A),",", mypr(B), "]", {append(A,B,Z)}.
mypro(Z) --> "[",atomy(X),",",mypr(A),"]", {Z=..[X,A]}.



%parse_sxml((A,B)) --> parse_sxml(A), ",", parse_sxml(B).
parse_sxml((A:-B)) --> "[env(':-',[],[", parse_sxml(A), ",", parse_sxml(B), "])]".
parse_sxml(Z) --> "[env(var,[],[]", {var(Z)}.
parse_sxml(Z) --> 
	"[env(atom,[],", atomy(A), ")],",
	parse_sxml(B),
	{(is_list(B),append([A],B,Z));append([A],[B],Z)}.

parse_sxml(Z) --> "[env(atom,[],", atomy(Z), ")]".

parse_sxml(Z) --> "[env(term,[],", parse_sxml(Z), ")]".
parse_sxml(Z) --> "[env(", atomy(F), ",[],[",parse_sxml(As),"])]", {append([F],As,FL), Z=..FL}.
parse_sxml([]).
%parse_sxml((A,B)) --> parse_sxml(A), ",", parse_sxml(B).

parse_r_sxml(Z) --> "[env(atom,[],", atomy(A), ")],", parse_r_sxml(B), {append([A],B,Z)}.
parse_r_sxml([Z]) --> "[env(atom,[],", atomy(Z), ")]".

%atomthing(_).
%atomthing(X) --> [[C]],{name(X,[C])}.
atomthing(X) --> atomy(C),{name(X,C),atom(X)}.

atomy(Z) --> [C], atomy(D), {name(H,[C]), atom_concat(H,D,Z)}. 
atomy(Z) --> [C], {name(Z,[C])}.



%----------------


xmyp1(X) -->
	{numbervars(X,0,_)},
	"env(prolog,[],[", xmyp(X), "])".

%xmyp(X) -->
%	{var(X),numbervars(X,0,_),X='$VAR'(Y), name(Y,N), append("V",N,VN)},
%	!,
%	"env(var,[],[",
%	VN,
%	"])".

xmyp(X) -->
	{var(X),%numbervars(X,0,_),
	X =.. [F|Args],
	name(F,FN)},
	!,
	"env(pred,[Name=",FN,"],[",
	xmyp(arg(Args)),
	"])".

xmyp((A,B)) -->
	!,
	xmyp(A),
	",",
	xmyp(B).

%xmyp([]).
xmyp([])-->
	!,
	"env(list,[],[[]])".

xmyp([H|T]) -->
	!,
	"env(list,[],[",
	xmyp(H),
	",",
	xmyp(T),
	"])".

xmyp(X) -->
	{atom(X),name(X,N)},
	!,
	"env(atom,[],[",
	N,
	"])".
xmyp(X) -->
	{number(X),name(X,N)},
	!,
	"env(number,[],[",
	N,
	"])".

xmyp(X) -->
	{X =.. [F|Args],
	functor(X,F,Ar),
	name(Ar,AN),
	name(F,FN)},
	!,
	"env(pred,[Name=",FN,",Arity=",AN,"],[",
	xmyp(Ar,arg(Args)),
	"])".


xmyp(0,arg(_)) --> "".
xmyp(N,arg([H|T])) -->
	!,
	{name(N,Ar)},
	"env(arg,[Arg=",Ar,"],[",xmyp(H),
	"])",
	{(N>1,Comma=",");Comma=""},
	Comma,
	{N1 is N-1},
	xmyp(N1,arg(T)).



xmypr1(X) --> "env(prolog,[],[",xmypr(X),"])".



%xmypr(argL([])) --> "".
%xmypr(argL([Arg])) --> xmypr(arg(Arg)).
%xmypr(argL(A)) -->  xmypr(argL(Z)), ",", xmypr(arg(Arg)), {append(Z,[Arg],A)}.


%xmypr(arg([])) --> "".

%xmypr(arg([Arg])) --> "env(arg,[],[", xmypr(Arg), "])".

axmypr(0,arg([])) --> "".
axmypr(Ar,arg(A)) --> {Ar>0}, "env(arg,[Arg=", xnumber(AN),{\+xend_tag(AN),AN=Ar},"],[", xmypr(Arg), "])", {A1 is Ar-1}, join(A1), axmypr(A1,arg(Z)), {append([Arg],Z,A)}.


join(0) --> "".
join(Ar) --> {Ar>0},",".



%xmypr(arg([])) --> "". 

xmypr(X) --> "env(atom,[],[", xatomey(X), {\+xend_tag(X)}, "])".
xmypr(X) --> "env(number,[],[", xnumber(X), {\+xend_tag(X)}, "])".
%xmypr(X) --> "env(var,[],[", xatomey(X), {\+xend_tag(X)}, "])".
xmypr([]) --> "env(list,[],[[]])".
xmypr(X) --> "env(list,[],[", xmypr(H), ",", xmypr(T), "])", {append([H],T,X)}.

xmypr(Z) --> 
	"env(pred,[Name=", xatomey(F), {\+xend_tag(F)},",Arity=", xnumber(Ar),{\+xend_tag(Ar)},"],[", axmypr(Ar,arg(A)), "])", {append([F],A,FL),Z=..FL}.

%xmypr(Z) --> 
%	"env(pred,[Name=", xatomey(F), {\+xend_tag(F)},"],[", axmypr(arg(A)), "])", 
%	join,
%	xmypr(N),
%	{append([F],A,FL),X=..FL, ((nonvar(N),Z=(X,N));(var(N),Z=X))}.

xmypr((A,B)) --> xmypr(A), ",", xmypr(B).

xnumber(Z) --> [C], {Z is C - 48}.
xnumber(Z) --> xnumber(X),[C], {Z is (X*10)+(C-48)}.


xatomey(Z) --> [C], {name(X,[C]),((number(X),lookupn(X,Z));(\+number(X),Z=X))}.
xatomey(Z) --> %[C], {\+[C]="<"}, 
	xatomey(D), [C], {name(X,[C]), ((number(X),lookupn(X,H));(\+number(X),H=X)), atom_concat(D,H,Z)}.
%xatomey(Z) --> [C], {name(Z,[C]), \+Z='<'}.
%xatomey('') --> "".

xend_tag(Z) :- 
	name(Z,N),
	append(B,_C,N),
	append(_A,"])",B).

lookupn(0,'0').
lookupn(1,'1').
lookupn(2,'2').
lookupn(3,'3').
lookupn(4,'4').
lookupn(5,'5').
lookupn(6,'6').
lookupn(7,'7').
lookupn(8,'8').
lookupn(9,'9').
