/*

  $Id: self_uri.pl,v 1.6 2005/04/05 20:30:28 sandro Exp $

  Manage "session" state encoded in the URI.

  Everything needs to pass along a structure we usually call PageState.



  PageState is a list with terms like
    focus='http:....'
  and
    stacking([....])

  The ones with = are meant to go out on the URI.  The ones without are
  meant to be used internally.  Some are both: "stacking(...)" gives us
  a list; "stacking=..." gives us an atom (ie list encoded).

  Note that if PageState has variables in it, it could be used as an
  accumulator ACROSS different views.   Best avoid that.

*/


self_uri(PageName, PageState, StateChanges, URI) :-
	self_uri(PageName, PageState, StateChanges, Codes, ""),
	atom_codes(URI, Codes).

self_uri(PageName, PageState, StateChanges) -->
	{ % print_message(warning, self_uri(PageName, PageState, StateChanges)),
	 args_merge(PageState, StateChanges, NewState) },
	%  "/",
	{ atom_codes(PageName, PageNameCodes) }, PageNameCodes, 
	( { NewState=[] }
	->  ""
	; "?", uri_form_list(NewState)
	).


safe_args_merge(Old, [], Old).
safe_args_merge(Old, [Left=Right|Tail], New) :-
	(  select(Left=_, Old, Rest)
	-> true
	;  Rest = Old
	),
	safe_args_merge([Left=Right|Rest], Tail, New).
args_merge(Old, New, Result) :-
	attrs_only(Old, Old1),
	attrs_only(New, New1),
	safe_args_merge(Old1, New1, Result).

attrs_only([], []).
attrs_only([X|Xs], Out) :-
	(  X = (_=_)
	-> Out=[Y|Ys], X=Y, attrs_only(Xs, Ys)
	;  attrs_only(Xs, Out)
	).

uri_form_list([One]) --> !, uri_form(One).
uri_form_list([First|Rest]) --> !, uri_form(First), "&", uri_form_list(Rest).

uri_form(Tag=Value) -->
	{ !, atom_codes(Tag, TagCodes) },
	TagCodes,
	"=",
	{ serialized(Value, ValueSerialized), !, 
	  www_form_encode(ValueSerialized, ValueEncoded),
	  atom_codes(ValueEncoded, ValueEncodedCodes) },
	ValueEncodedCodes.

serialized(X, S) :-
	atom(X), X=S.
serialized(X, S) :-
	number(X), atom_number(S, X).
serialized(X, S) :-
	is_list(X), concat_atom(X, ',', S).
serialized(X, _) :-
	throw(cant_serialize_to_put_inside_URI(X)).




unit_test(args_merge([1,2,a=b,3,x=d], [], [a=b, x=d])).
unit_test(args_merge([1,2,a=b,3,x=d], [x=4], [x=4, a=b])).
unit_test(args_merge([1,2,a=b,3,x=d], [x=4, x=5], [x=5, a=b])).
unit_test(args_merge([1,2,a=b,3,x=d], [foo, x=4, bar/baz, x=5, blob], [x=5, a=b])).
	     

unit_test(self_uri('/foo', [], [], "/foo", "")).
unit_test(self_uri('/foo', [a=b], [], "/foo?a=b", "")).
unit_test(self_uri('/foo', [a='1 2 3='''], [], "/foo?a=1+2+3%3d%27", "")).
unit_test(self_uri('/foo', [a=b, c=d], [], "/foo?a=b&c=d", "")).
unit_test(self_uri('/foo', [a=b, c=d], [c=e], "/foo?c=e&a=b", "")).
unit_test(self_uri('/foo', [a/b], [], "/foo", "")).

% UH OH!   Why does this fail in 5.5.11 ?   
% unit_test(self_uri(configure, [focus='http://www.w3.org/2000/01/rdf-schema#Class', stacking(['Tree View', 'Folded Graph View'])], [], "configure?focus=http%3a%2f%2fwww%2ew3%2eorg%2f2000%2f01%2frdf%2dschema%23Class", "")).
