:- module(yaz_user,
	  []).

:- use_module(library(http/http_dispatch)).
:- use_module(library(http/http_parameters)).
:- use_module(library(http/http_path)).
:- use_module(library(http/html_write)).
:- use_module(library(http/html_head)).
:- use_module(library(http/js_write)).
:- use_module(library(http/http_json)).
:- use_module(library(http/json)).
:- use_module(user(user_db)).
:- use_module(library(semweb/rdf_db)).

:- use_module(components(yaz_page)).
:- use_module(components(tag_cloud)).
:- use_module(library(videos)).

:- http_handler(yaz(user), http_yaz_user, []).

%%	http_yaz_user(+Request)
%
%	User profile page

http_yaz_user(Request) :-
	ensure_logged_on(User),
	http_parameters(Request,
			[ tags(Tags,
			       [ optional(true),
				 description('String with tags separated by a comma')
			       ])
			]),
	user_profile_tags(User, ProfileTags0),
	(   nonvar(Tags)
	->  ProfileTags = NewTags,
	    concat_atom(NewTags0, ',', Tags),
	    maplist(trim_spaces, NewTags0, NewTags1),
	    sort(NewTags1, NewTags),
	    update_tags(NewTags, ProfileTags0, User)
	;   ProfileTags = ProfileTags0
	),
	html_page(User, ProfileTags, []).

update_tags(NewTags, OldTags, User) :-
	ord_subtract(NewTags, OldTags, Add),
	ord_subtract(OldTags, NewTags, Remove),
	rdf_transaction((forall(member(R,Remove),
				rdf_retractall(User, pprime:profileTag, literal(R), User)),
			 forall(member(A,Add),
				rdf_assert(User, pprime:profileTag, literal(A), User))

			)).

user_profile_tags(User, Tags) :-
	findall(Tag, rdf(User, pprime:profileTag, literal(Tag)), Tags0),
	sort(Tags0, Tags).




html_page(User, ProfileTags, VideoTags) :-
	reply_html_page(yaz,
			[ title(['YAZ - ', User])
			],
			[ h2(User),
			  div([class(topic)],
			      [ div(class(header), 'Statistics'),
				div(class(body),
				    \html_user_statistics(User))
			      ]),
			  div([class(topic)],
			      [ div(class(header), 'Profile'),
				div(class(body),
				    [ \html_tag_field(ProfileTags),
				      \html_tag_cloud(VideoTags, [])
				    ])
			      ])
			]).

html_user_statistics(User) -->
	{ active_videos(User, QL),
	  moderated_videos(User, ML),
	  length(QL, QN),
	  length(ML, MN),
	  http_link_to_id(http_yaz_videos, [user(User)], HREF)
	},
	html(ul([li([MN, ' ', \video_label(MN), ' moderated by you', \browse(HREF, moderated)]),
		 li([QN, ' ', \video_label(ML), ' waiting for your moderation', \browse(HREF, queue)])
		])).

browse(HREF, Type) -->
	html([' (', a(href(HREF+'&type='+Type), browse), ')']).



html_tag_field(Tags) -->
	html(form(action(location_by_id(http_yaz_user)),
		  [textarea([name(tags), id(tags)],
			    \html_tags(Tags)),
		   div(class(buttons),
		       [ input(type(submit))
		       ])
		  ])).

html_tags([]) --> !.
html_tags([Tag]) --> !, html(Tag).
html_tags([Tag|T]) -->
	html([Tag, ', ']),
	html_tags(T).




trim_spaces(A0,A) :-
	atom_codes(A0, Codes0),
	phrase(trim(Codes0), Codes),
	atom_codes(A, Codes).

trim([]) -->
	[].
trim([H|T]) -->
	trim_code(H), !,
	trim(T).
trim([H|T]) -->
	[H],
	trim(T).

trim_code(32) --> !.
trim_code(13) --> !.
trim_code(10) --> !.