1/*  Part of SWI-Prolog
    2
    3    Author:        Wouter Beek & Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2014, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(post,
   31	  [ find_posts/3,		% +Kind:oneof([annotation,news])
   32					% :CheckId
   33					% -Ids:list(atom)
   34	    fresh/1,			% ?Id:atom
   35	    all/1,			% ?Id:atom
   36	    post/3,			% ?Post:or([atom,compound])
   37					% ?Name:atom
   38					% ?Value
   39	    post//2,			% +Post, +Options
   40	    posts//4,			% +Kind, +Object, +Ids, +Options
   41	    add_post_link//2,		% +Kind, +Object
   42	    relevance/2,		% +Id:atom
   43					% -Relevance:between(0.0,1.0)
   44	    post_process/2,		% +Request:list, +Id:atom
   45	    sort_posts/2,		% +Ids:list(atom), -SortedIds:list(atom)
   46
   47	    user_posts//2,		% +User, +KInd
   48	    user_post_count/3,		% +User, +Kind, -Count
   49	    user_vote_count/3		% +User, -Up, -Down
   50	  ]).   51
   52/** <module> Posts
   53
   54@author Wouter Beek
   55@tbd Type-based JS response.
   56     After DELETE: remove that post from DOM.
   57     After POST: add that post to DOM.
   58     After PUT: update that post in DOM.
   59*/
   60
   61:- use_module(library(error)).   62:- use_module(library(http/html_head)).   63:- use_module(library(http/html_write)).   64:- use_module(library(http/http_dispatch)).   65:- use_module(library(http/http_json)).   66:- use_module(library(http/http_path)).   67:- use_module(library(http/js_write)).   68:- use_module(library(lists)).   69:- use_module(library(option)).   70:- use_module(library(apply)).   71:- use_module(library(pairs)).   72:- use_module(library(persistency)).   73:- use_module(library(pldoc/doc_html)).   74:- use_module(library(uri)).   75:- use_module(library(md5)).   76:- use_module(library(dcg/basics)).   77:- use_module(library(aggregate)).   78
   79:- use_module(object_support).   80:- use_module(openid).   81:- use_module(notify).   82:- use_module(generics).   83
   84:- meta_predicate
   85	find_posts(+,1,-).   86
   87:- html_resource(css('post.css'), []).   88:- html_resource(js('markitup/sets/pldoc/set.js'),
   89		 [ requires([ js('markitup/jquery.markitup.js'),
   90			      js('markitup/skins/markitup/style.css'),
   91			      js('markitup/sets/pldoc/style.css')
   92			    ])
   93		 ]).   94
   95:- persistent
   96	post(id:atom,
   97	     post:dict),
   98	vote(id:atom,			% post id
   99	     value:integer,		% value (up:1, down:-1)
  100	     user:atom,			% user who voted
  101	     time:integer).		% time of the vote
  102
  103:- initialization
  104	absolute_file_name(data('post.db'), File,
  105			   [ access(write) ]),
  106	db_attach(File, [sync(close)]).  107
  108:- http_handler(root(vote), vote, []).  109
  110:- op(100, xf, ?).  111
  112post_type(post{kind:oneof([annotation,news]),
  113	       title:string?,
  114	       content:string,
  115	       meta:meta{id:atom,
  116			 author:atom,
  117			 object:any?,
  118			 importance:between(0.0,1.0)?,
  119			 time:time{created:number,
  120				   modified:number?,
  121				   'freshness-lifetime':number?}}}).
  122
  123%%	convert_post(+Dict0, -Dict) is det.
  124%
  125%	@error	May throw type and instantiation errors.
  126%	@tbd	Introduce type-testing support in library(error).
  127
  128convert_post(Post0, Post) :-
  129	post_type(Type),
  130	convert_dict(Type, Post0, Post).
  131
  132%%	convert_dict(+Type, +DictIn, -DictOut) is det.
  133
  134convert_dict(TypeDict, Dict0, Dict) :-
  135	is_dict(TypeDict), !,
  136	dict_pairs(TypeDict, Tag, TypePairs),
  137	dict_values(TypePairs, Dict0, Pairs),
  138	dict_pairs(Dict, Tag, Pairs).
  139convert_dict(atom, String, Atom) :- !,
  140	atom_string(Atom, String).
  141convert_dict(oneof(Atoms), String, Atom) :-
  142	maplist(atom, Atoms), !,
  143	atom_string(Atom, String),
  144	must_be(oneof(Atoms), Atom).
  145convert_dict(float, Number, Float) :- !,
  146	Float is float(Number).
  147convert_dict(list(Type), List0, List) :- !,
  148	must_be(list, List0),
  149	maplist(convert_dict(Type), List0, List).
  150convert_dict(Type, Value, Value) :-
  151	must_be(Type, Value).
  152
  153dict_values([], _, []).
  154dict_values([Name-Type|TP], Dict, [Name-Value|TV]) :-
  155	dict_value(Type, Name, Dict, Value), !,
  156	dict_values(TP, Dict, TV).
  157dict_values([_|TP], Dict, TV) :-
  158	dict_values(TP, Dict, TV).
  159
  160dict_value(Type?, Name, Dict, Value) :- !,
  161	get_dict(Name, Dict, Value0),
  162	Value0 \== null,
  163	convert_dict(Type, Value0, Value).
  164dict_value(Type, Name, Dict, Value) :-
  165	convert_dict(Type, Dict.Name, Value).
  166
  167%%	retract_post(+Id)
  168%
  169%	Remove post Id from the database.
  170
  171retract_post(Id):-
  172	retract_post(Id, _).
  173
  174%%	convert_post(+JSON, +Kind, +Id, +Author, +TimeProperty, -Post) is det.
  175%
  176%	Convert a post object into its Prolog equivalent.
  177
  178convert_post(Post0, Kind, Id, Author, TimeProperty, Post) :-
  179	get_time(Now),
  180	(   atom_string(ObjectID, Post0.meta.get(about)),
  181	    object_id(Object, ObjectID)
  182	->  Post1 = Post0.put(meta/object, Object)
  183	;   Post1 = Post0
  184	),
  185	Post2 = Post1.put(kind, Kind)
  186	             .put(meta/id, Id)
  187		     .put(meta/author, Author)
  188		     .put(meta/time/TimeProperty, Now),
  189	convert_post(Post2, Post).
  190
  191
  192%%	post_url(+Id, -HREF) is det.
  193%
  194%	True when HREF is a link to post Id.
  195
  196post_url(Id, HREF) :-
  197	post(Id, kind, Kind),
  198	(   kind_handler(Kind, HandlerId)
  199	->  http_link_to_id(HandlerId, path_postfix(Id), HREF)
  200	;   domain_error(kind, Kind)
  201	).
  202
  203kind_handler(news,	 news_process).
  204kind_handler(annotation, annotation_process).
  205
  206%%	post_link(+Id)
  207%
  208%	Generate a link to post Id.
  209
  210post_link(Id) -->
  211	{ post_url(Id, HREF)
  212	},
  213	html(a(href(HREF), \post_link_text(Id))).
  214
  215post_link_text(Id) -->
  216	{ post(Id, title, Title) },
  217	html(Title).
  218post_link_text(Id) -->
  219	{ post(Id, object, Object),
  220	  object_label(Object, Label)
  221	},
  222	html(Label).
  223
  224%%	post_process(+Request, ?Kind) is det.
  225%
  226%	HTTP handler that implements a REST interface for postings.
  227%
  228%	@arg	Kind is the type of post, and is one of =news= or
  229%		=annotation=.
  230
  231post_process(Request, Kind) :-
  232	request_to_id(Request, Kind, Id),
  233	must_be(oneof([news,annotation]), Kind),
  234	memberchk(method(Method), Request),
  235	(   site_user_logged_in(User)
  236	->  true
  237	;   User = anonymous
  238	),
  239	post_process(Method, Request, Kind, User, Id).
  240
  241%%	post_process(+Method, +Request, +Kind, +Id, +User) is det.
  242%
  243%	Implement the REST replies.
  244
  245% DELETE
  246post_process(delete, Request, Kind, User, Id) :-
  247	post_authorized(Request, User, Kind),
  248	post(Id, author, Author), !,
  249	(   (   Author == User
  250	    ;	site_user_property(User, granted(admin))
  251	    )
  252	->  post(Id, about, About),
  253	    retract_post(Id, OldPost),
  254	    notify(About, post_deleted(OldPost)),
  255	    throw(http_reply(no_content))	% 204
  256	;   memberchk(path(Path), Request),
  257	    throw(http_reply(forbidden(Path)))	% 403
  258	).
  259post_process(delete, Request, _, _, _) :-
  260	http_404([], Request).
  261
  262% GET
  263post_process(get, _, _, _, Id):-
  264	post(Id, Post), !,
  265	reply_json(Post).
  266post_process(get, Request, _, _, _):-
  267	http_404([], Request).
  268
  269% POST
  270post_process(post, Request, Kind, User, _):-
  271	post_authorized(Request, User, Kind),
  272	catch(( http_read_json_dict(Request, Post0),
  273		uuid(Id),
  274		convert_post(Post0, Kind, Id, User, created, NewPost),
  275		assert_post(Id, NewPost)
  276	      ),
  277	      E,
  278	      throw(http_reply(bad_request(E)))),
  279	post(Id, about, About),
  280	notify(About, post_created(NewPost)),
  281	memberchk(path(Path), Request),
  282	atom_concat(Path, Id, NewLocation),
  283	format('Location: ~w~n', [NewLocation]),
  284	reply_json(_{created:Id, href:NewLocation},
  285		   [status(201)]).
  286
  287% PUT
  288post_process(put, Request, Kind, User, Id):-
  289	post_authorized(Request, User, Kind),
  290	post(Id, created, Created),
  291	catch(( http_read_json_dict(Request, Post0),
  292		convert_post(Post0.put(meta/time/created, Created),
  293			     Kind, Id, User, modified,
  294			     NewPost)
  295	      ),
  296	      E,
  297	      throw(http_reply(bad_request(E)))),
  298	(   post(Id, author, Author)
  299	->  (   Author == User
  300	    ->  retract_post(Id, OldPost),
  301		assert_post(Id, NewPost),
  302		post(Id, about, About),
  303		notify(About, post_updated(OldPost, NewPost)),
  304		throw(http_reply(no_content))
  305	    ;   memberchk(path(Path), Request),
  306		throw(http_reply(forbidden(Path)))
  307	    )
  308	;   http_404([], Request)
  309	).
  310
  311:- dynamic debug_allow_all_posts/0.  312
  313%%	debug_posts is det
  314%
  315%	Defeats normal authorization checking for posts,
  316%	so during development we don't need to struggle with OAuth,
  317%	emails, etc.
  318%
  319debug_posts :-
  320	writeln('Anyone may now debug posts'),
  321	asserta(debug_allow_all_posts).
  322
  323%%	nodebug_posts is det
  324%
  325%	remove the effects of debug_posts
  326%
  327nodebug_posts :-
  328	writeln('Back to normal post control'),
  329	retractall(debug_allow_all_posts).
  330
  331
  332%%	post_authorized(+Request, +User, +Kind) is det.
  333%
  334%	@throws	http_reply(forbidden(Path)) if the user is not allowed
  335%		to post.
  336%	@tbd	If the user is =anonymous=, we should reply 401 instead
  337%		of 403, but we want OpenID login
  338
  339post_authorized(_Request, User, Kind) :-
  340	post_granted(User, Kind), !.
  341post_authorized(Request, _User, _Kind) :-
  342	memberchk(path(Path), Request),
  343	throw(http_reply(forbidden(Path))).
  344
  345post_granted(_, _) :- debug_allow_all_posts.
  346post_granted(User, Kind) :-
  347	site_user_property(User, granted(Kind)), !.
  348post_granted(User, annotation) :-
  349	User \== anonymous.
  350
  351
  352%!	post(+Post, +Name:atom, -Value) is semidet.
  353%!	post(+Post, ?Name:atom, -Value) is nondet.
  354%!	post(-Post, ?Name:atom, -Value) is nondet.
  355%
  356%	True if Post have Value for the given attribute.
  357%
  358%	@arg	If Post is given, it is either the id of a post or a dict
  359%		describing the post.  When generated, Post is the (atom)
  360%		identifier of the post.
  361
  362post(PostOrId, Name, Value) :-
  363	nonvar(PostOrId), !,
  364	(   atom(PostOrId)
  365	->  post(PostOrId, Post)
  366	;   Post = PostOrId
  367	),
  368	post1(Name, Post, Value),
  369	Value \== null.
  370post(Id, Name, Value) :-
  371	post(Id, Post),
  372	post1(Name, Post, Value).
  373
  374post1(object, Post, Object) :-
  375	Object = Post.meta.get(object).
  376post1(about, Post, About) :-			% used for notification
  377	(   About = Post.meta.get(object)
  378	->  true
  379	;   About = Post.kind
  380	).
  381post1(author, Post, Author) :-
  382	Author = Post.meta.author.
  383post1(content, Post, Content) :-
  384	Content = Post.content.
  385post1('freshness-lifetime', Post, FreshnessLifetime ) :-
  386	FreshnessLifetime = Post.meta.time.'freshness-lifetime'.
  387post1(id, Post, Id) :-
  388	Id = Post.meta.id.
  389post1(importance, Post, Importance) :-
  390	Importance = Post.meta.importance.
  391post1(kind, Post, Kind) :-
  392	Kind = Post.kind.
  393post1(meta, Post, Meta) :-
  394	Meta = Post.meta.
  395post1(created, Post, Posted) :-
  396	Posted = Post.meta.time.created.
  397post1(modified, Post, Posted) :-
  398	Posted = Post.meta.time.modified.
  399post1(time, Post, Time):-
  400	Time = Post.meta.time.
  401post1(title, Post, Title) :-
  402	Title = Post.get(title).
  403post1(votes, Post, Votes) :-
  404	aggregate_all(sum(Vote), vote(Post.meta.id, Vote), Votes).
  405post1(votes_up, Post, Up) :-
  406	aggregate_all(sum(Vote), vote_up(Post.meta.id, Vote), Up).
  407post1(votes_down, Post, Down) :-
  408	aggregate_all(sum(Vote), vote_down(Post.meta.id, Vote), Down).
  409
  410
  411%!	post(+Id:atom, +Options)// is det.
  412%
  413%	Generate HTML for apost.  Supported Options:
  414%
  415%	  * orientation(+Orientation:oneof([left,right]))
  416%	  Orientation of the post.  This is used in binary conversations
  417%         to show the different conversation parties.
  418%	  * standalone(+Standalone:boolean)
  419%	  Whether this post is part of multiple posts or not.
  420
  421post(Id, Options) -->
  422	{ post(Id, kind, Kind),
  423	  (   option(orientation(Orient), Options),
  424	      Orient \== none
  425	  ->  Extra = [ style('float:'+Orient+';') ]
  426	  ;   Extra = []
  427	  )
  428	},
  429
  430	html(article([ class([post,Kind]),
  431		       id(Id)
  432		     | Extra
  433		     ],
  434		     [ \post_header(Id, Options),
  435		       \post_section(Id),
  436		       \edit_delete_post(Id)
  437		     ])),
  438
  439	(   { option(standalone(true), Options, true) }
  440	->  html_requires(css('post.css')),
  441	    (   { site_user_logged_in(_) }
  442	    ->  {   post(Id, about, Object),
  443		    object_id(Object, About)
  444		->  true
  445		;   About = @(null)
  446		},
  447	        html(\write_post_js(Kind, About))
  448	    ;   login_post(Kind)
  449	    )
  450	;   []
  451	).
  452
  453%!	post_header(+Id, +Options)// is det.
  454%
  455%	When    the    post     appears      in     isolation    (option
  456%	standalone(true)), the title is not displayed.
  457
  458post_header(Id, O1) -->
  459	html(header([],
  460		    [ \post_title(O1, Id),
  461		      \post_metadata(Id),
  462		      span(class='post-links-and-votes',
  463			   [ \post_votes(Id),
  464			     \html_receive(edit_delete(Id))
  465			   ])
  466		    ])).
  467
  468post_metadata(Id) -->
  469	{post(Id, kind, Kind)},
  470	post_metadata(Kind, Id).
  471
  472post_metadata(annotation, Id) -->
  473	{post(Id, author, Author)},
  474	html(span(class='post-meta',
  475		  [ \user_profile_link(Author),
  476		    ' said (',
  477		    \post_time(Id),
  478		    '):'
  479		  ])).
  480post_metadata(news, Id) -->
  481	{post(Id, author, Author)},
  482	html(span(class='post-meta',
  483		  [ 'By ',
  484		    \user_profile_link(Author),
  485		    ' at ',
  486		    \post_time(Id)
  487		  ])).
  488
  489post_section(Id) -->
  490	{ post(Id, author, Author),
  491	  post(Id, content, Content),
  492	  atom_codes(Content, Codes),
  493	  wiki_file_codes_to_dom(Codes, /, DOM1),
  494	  clean_dom(DOM1, DOM2)
  495	},
  496	html(section([],
  497		     [ \author_image(Author),
  498		       div(class='read-post', DOM2)
  499		     ])).
  500
  501post_time(Id) -->
  502	{ post(Id, created, Posted) }, !,
  503	html(\dateTime(Posted)).
  504post_time(_) --> [].
  505
  506post_title(O1, Id) -->
  507	{ option(standalone(false), O1, true),
  508	  post(Id, title, Title), !,
  509	  post_url(Id, HREF)
  510	},
  511	html(h2(class('post-title'), a(href(HREF),Title))).
  512post_title(_, _) --> [].
  513
  514post_votes(Id) -->
  515	{ post(Id, votes_down, Down),
  516	  format(atom(AltDown), '~d downvotes', [Down]),
  517	  post(Id, votes_up, Up),
  518	  format(atom(AltUp), '~d upvotes', [Up]),
  519	  post(Id, votes, Amount),
  520	  http_absolute_location(icons('vote_up.gif'), UpIMG, []),
  521	  http_absolute_location(icons('vote_down.gif'), DownIMG, [])
  522	},
  523	html([ a([class='post-vote-up',href=''],
  524		 img([alt(AltUp),src(UpIMG),title(Up)], [])),
  525	       ' ',
  526	       span(class='post-vote-amount', Amount),
  527	       ' ',
  528	       a([class='post-vote-down',href=''],
  529		 img([alt(AltDown),src(DownIMG),title(Down)], []))
  530	     ]).
  531
  532
  533%%	posts(+Kind, +Object, +Ids:list(atom), +Options)//
  534%
  535%	Generate HTML for a list of posts and add a link to add new
  536%	posts.  Options:
  537%
  538%	  * order_by(+Property)
  539%	  Order posts by Property.  Properties are defined by post/3.
  540%	  * add_add_link(+Boolean)
  541%	  Add link to add new posts.  Default is =true=.
  542
  543posts(Kind, Object, Ids1, Options) -->
  544	{ atomic_list_concat([Kind,component], '-', Class),
  545	  default_order(Kind, DefOrder),
  546	  option(order_by(OrderBy), Options, DefOrder),
  547	  sort_posts(Ids1, OrderBy, Ids2)
  548	},
  549	html_requires(css('post.css')),
  550	html([ div(class=[posts,Class],
  551		   \post_list(Ids2, Kind, none))
  552	     ]),
  553	(   { option(add_add_link(true), Options, true) }
  554	->  add_post_link(Kind, Object)
  555	;   []
  556	).
  557
  558default_order(news, created).
  559default_order(annotation, votes).
  560
  561
  562post_list([], _Kind, _Orient) --> [].
  563post_list([Id|Ids], Kind, Orient1) -->
  564	post(Id, [orientation(Orient1),standalone(false)]),
  565	{switch_orientation(Orient1, Orient2)},
  566	post_list(Ids, Kind, Orient2).
  567
  568switch_orientation(left,  right).
  569switch_orientation(right, left).
  570switch_orientation(none,  none).
  571
  572
  573%%	add_post_link(+Kind, +Object)//
  574%
  575%	Emit HTML that allows for adding a new post
  576
  577add_post_link(Kind, Object) -->
  578	{ site_user_logged_in(User),
  579	  post_granted(User, Kind),
  580	  (   Object == null
  581	  ->  About = @(null)
  582	  ;   object_id(Object, About)
  583	  ),
  584	  Id = ''			% empty id
  585	}, !,
  586	html(div(id='add-post',
  587		 [ \add_post_link(Kind),
  588		   form([id='add-post-content',style='display:none;'],
  589			table([ tr(td(\add_post_title(Id, Kind))),
  590				tr(td([ \add_post_importance(Id, Kind),
  591					\add_post_freshnesslifetime(Id, Kind)
  592				      ])),
  593				tr(td(\add_post_content(Id))),
  594				tr(td(\submit_post_links(Kind)))
  595			      ])),
  596		   \write_post_js(Kind, About)
  597		 ])).
  598add_post_link(Kind, _) -->
  599	login_post(Kind).
  600
  601add_post_content(Id) -->
  602	{   Id \== '', post(Id, content, Content)
  603	->  true
  604	;   Content = []
  605	},
  606	html(textarea([class(markItUp)], Content)).
  607
  608%%	add_post_freshnesslifetime(+Kind)
  609%
  610%	Add fressness menu if Kind = =news=.  Freshness times are
  611%	represented as seconds.
  612
  613add_post_freshnesslifetime(Id, news) --> !,
  614	{   Id \== '', post(Id, 'freshness-lifetime', Default)
  615	->  true
  616	;   menu(freshness, 'One month', Default)
  617	},
  618	html([ label([], 'Freshness lifetime: '),
  619	       select(class='freshness-lifetime',
  620		      \options(freshness, Default)),
  621	       br([])
  622	     ]).
  623add_post_freshnesslifetime(_, _) --> [].
  624
  625add_post_importance(Id, news) --> !,
  626	{   Id \== '', post(Id, importance, Importance)
  627	->  true
  628	;   menu(importance, 'Normal', Importance)
  629	},
  630	html([ label([], 'Importance: '),
  631	       select(class=importance,
  632		      \options(importance, Importance))
  633	     ]).
  634add_post_importance(_, _) --> [].
  635
  636options(Key, Default) -->
  637	{ findall(Name-Value, menu(Key, Name, Value), Pairs) },
  638	option_list(Pairs, Default).
  639
  640option_list([], _) --> [].
  641option_list([Name-Value|T], Default) -->
  642	{   Name == Default
  643	->  Extra = [selected(selected)]
  644	;   Extra = []
  645	},
  646	html(option([value(Value)|Extra], Name)),
  647	option_list(T, Default).
  648
  649
  650menu(freshness, 'One year',  Secs) :- Secs is 365*24*3600.
  651menu(freshness, 'One month', Secs) :- Secs is 31*24*3600.
  652menu(freshness, 'One week',  Secs) :- Secs is 7*24*3600.
  653menu(freshness, 'One day',   Secs) :- Secs is 1*24*3600.
  654
  655menu(importance, 'Very high', 1.00).
  656menu(importance, 'High',      0.75).
  657menu(importance, 'Normal',    0.50).
  658menu(importance, 'Low',	      0.25).
  659menu(importance, 'Very low',  0.00).
  660
  661
  662add_post_link(Kind) -->
  663	html(a([id('add-post-link'),href('')],
  664	       \add_post_label(Kind))).
  665
  666add_post_label(news) -->
  667	html('Post new article').
  668add_post_label(annotation) -->
  669	html('Add comment').
  670
  671add_post_title(Id, news) --> !,
  672	{   Id \== '', post(Id, title, Title)
  673	->  Extra = [value(Title)]
  674	;   Extra = []
  675	},
  676	html([ label([], 'Title: '),
  677	       input([ class(title),
  678		       size(70),
  679		       type(text)
  680		     | Extra
  681		     ], []),
  682	       br([])
  683	     ]).
  684add_post_title(_, _) --> [].
  685
  686submit_post_links(Kind) -->
  687	html(div([ id='add-post-links',style='display:none;'],
  688		 [ a([id='add-post-submit',href=''], \submit_post_label(Kind)),
  689		   a([id='add-post-cancel',href=''], 'Cancel')
  690		 ])).
  691
  692submit_post_label(news) -->
  693	html('Submit article').
  694submit_post_label(annotation) -->
  695	html('Submit comment').
  696
  697%%	edit_post_form(+Id)//
  698%
  699%	Provide a non-displayed editor for post Id if the author of this
  700%	post is logged on.
  701
  702edit_post_form(Id) -->
  703	{ site_user_logged_in(User),
  704	  edit_post_granted(Id, User), !,
  705	  post(Id, kind, Kind)
  706	},
  707	html([ form([class='edit-post-content',style='display:none;'],
  708		    table([ tr(td(\add_post_title(Id, Kind))),
  709			    tr(td([ \add_post_importance(Id, Kind),
  710				    \add_post_freshnesslifetime(Id, Kind)
  711				  ])),
  712			    tr(td(\add_post_content(Id))),
  713			    tr(td(\save_post_links(Kind)))
  714			  ]))
  715	     ]).
  716edit_post_form(_) --> [].
  717
  718edit_delete_post(Id) -->
  719	{ site_user_logged_in(User),
  720	  edit_post_granted(Id, User), !
  721	},
  722	html([ \html_post(edit_delete(Id), \edit_delete_post_link),
  723	       \edit_post_form(Id)
  724	     ]).
  725edit_delete_post(_) --> [].
  726
  727edit_delete_post_link -->
  728	html([ ' ',
  729	       a([class='edit-post-link',href=''], 'Edit'),
  730	       '/',
  731	       a([class='delete-post-link',href=''], 'Delete')
  732	     ]).
  733
  734save_post_links(Kind) -->
  735	html(div([class='save-post-links',style='display:none;'],
  736		 [ a([class='save-post-submit',href=''],
  737		     \save_post_title(Kind)),
  738		   a([class='save-post-cancel',href=''],
  739		     'Cancel')
  740		 ])).
  741
  742save_post_title(news) -->
  743	html('Save updated article').
  744save_post_title(annotation) -->
  745	html('Save updated comment').
  746
  747edit_post_granted(_Id, User) :-
  748	site_user_property(User, granted(admin)), !.
  749edit_post_granted(Id, User) :-
  750	post(Id, author, Author),
  751	User == Author.
  752
  753%!	age(+Id:atom, -Age) is det.
  754%
  755%	True when post Id was created Age seconds ago.
  756
  757age(Id, Age):-
  758	post(Id, created, Posted),
  759	get_time(Now),
  760	Age is Now - Posted.
  761
  762%!	author_image(+User:atom)// is det.
  763
  764author_image(User) -->
  765	{ site_user_property(User, name(Name)),
  766	  format(atom(Alt), 'Picture of user ~w.', [Name]),
  767	  user_avatar(User, Avatar),
  768	  http_link_to_id(view_profile, [user(User)], Link)
  769	},
  770	html(a(href(Link),
  771	       img([ alt(Alt),
  772		     class('post-avatar'),
  773		     src(Avatar),
  774		     title(Name)
  775		   ]))).
  776
  777%%	user_avatar(+User, -AvatarImageLink) is det.
  778%
  779%	@see https://en.gravatar.com/site/implement/hash/
  780%	@see https://en.gravatar.com/site/implement/images/
  781
  782user_avatar(User, URL) :-
  783	site_user_property(User, email(Email)),
  784	downcase_atom(Email, CanonicalEmail),
  785	md5_hash(CanonicalEmail, Hash, []),
  786	atom_concat('/avatar/', Hash, Path),
  787	uri_data(scheme,    Components, https),
  788	uri_data(authority, Components, 'www.gravatar.com'),
  789	uri_data(path,      Components, Path),
  790	uri_components(URL, Components).
  791
  792dateTime(TimeStamp) -->
  793	{ format_time(atom(Date), '%Y-%m-%dT%H:%M:%S', TimeStamp) },
  794	html(span([class(date),title(TimeStamp)], Date)).
  795
  796%!	find_posts(+Kind, :CheckId, -Ids) is det.
  797%
  798%	True when Ids  is  a  list  of   all  posts  of  Kind  for which
  799%	call(CheckId, Id) is true.
  800
  801find_posts(Kind, CheckId, Ids):-
  802	findall(Id,
  803		( post(Id, Post),
  804		  post(Post, kind, Kind),
  805		  call(CheckId, Id)
  806		),
  807		Ids).
  808
  809%!	fresh(+Id:atom) is semidet.
  810%
  811%	True if post Id is considered _fresh_.
  812
  813fresh(Id):-
  814	post(Id, 'freshness-lifetime', FreshnessLifetime),
  815	nonvar(FreshnessLifetime), !,
  816	age(Id, Age),
  817	Age < FreshnessLifetime.
  818fresh(_).
  819
  820%!	all(+Id:atom) is det.
  821%
  822%	News filter, returning all objects
  823
  824all(_).
  825
  826%! relevance(+Id:atom, -Relevance:between(0.0,1.0)) is det.
  827% - If `Importance` is higher, then the dropoff of `Relevance` is flatter.
  828% - `Relevance` is 0.0 if `FreshnessLifetime =< Age`.
  829% - `Relevance` is 1.0 if `Age == 0`.
  830
  831relevance(Id, Relevance) :-
  832	fresh(Id),
  833	post(Id, importance, Importance),
  834	nonvar(Importance),
  835	post(Id, 'freshness-lifetime', FreshnessLifetime),
  836	nonvar(FreshnessLifetime), !,
  837	age(Id, Age),
  838	Relevance is Importance * (1 - Age / FreshnessLifetime).
  839relevance(_, 0.0).
  840
  841sort_posts(Ids, SortedIds):-
  842	sort_posts(Ids, created, SortedIds).
  843
  844sort_posts(Ids, Property, SortedIds):-
  845	map_list_to_pairs(post_property(Property), Ids, Pairs),
  846	keysort(Pairs, SortedPairs),
  847	reverse(SortedPairs, RevSorted),
  848	pairs_values(RevSorted, SortedIds).
  849
  850post_property(Property, Id, Value) :-
  851	post(Id, Property, Value).
  852
  853%%	login_post(+Kind)//
  854%
  855%	Suggest to login or request  permission   to  get  access to the
  856%	posting facility.
  857
  858login_post(Kind) -->
  859	{ site_user_logged_in(_), !,
  860	  http_link_to_id(register, [for(Kind)], HREF)
  861	},
  862	html({|html(HREF, Kind)||
  863	      <div class="post-login">
  864	      <a href="HREF">request permission</a> to add a new
  865	      <span>Kind</span> post.
  866	      </div>
  867	     |}).
  868login_post(Kind) -->
  869	html(div(class='post-login',
  870		 [b(\login_link),' to add a new ',Kind,' post.'])).
  871
  872%%	write_post_js(+Kind, +About)//
  873%
  874%	Emit JavaScript to manage posts.
  875
  876write_post_js(Kind, About) -->
  877	{ kind_handler(Kind, HandlerId),
  878	  http_link_to_id(HandlerId, path_postfix(''), URL),
  879	  http_link_to_id(vote, [], VoteURL)
  880	},
  881	html_requires(js('markitup/sets/pldoc/set.js')),
  882	html_requires(js('post.js')),
  883	js_script({|javascript(URL,VoteURL,About)||
  884		   $(document).ready(function() {
  885		      prepare_post(URL, VoteURL, About);
  886		   });
  887		  |}).
  888
  889
  890		 /*******************************
  891		 *	      VOTING		*
  892		 *******************************/
  893
  894%%	vote(+Request)
  895%
  896%	HTTP POST handler for handling a vote.   The  posted object is a
  897%	JSON object containing the post it and vote.
  898%
  899%	Returns a JSON object holding the current number of votes.
  900
  901vote(Request) :-
  902	site_user_logged_in(User), !,	% any logged in user can vote
  903	catch(( memberchk(method(post), Request),
  904		http_read_json_dict(Request, Dict),
  905		atom_string(Id, Dict.id),
  906		vote(Id, User, Dict.vote)
  907	      ), E,
  908	      throw(http_reply(bad_request(E)))),
  909	post(Id, votes, Votes),
  910	reply_json(_{votes:Votes}).
  911vote(Request) :-
  912	memberchk(path(Path), Request),
  913	throw(http_reply(forbidden(Path))).
  914
  915%%	vote(+PostId, +User, +Vote) is det.
  916%
  917%	Add a vote for PostId.
  918
  919vote(Post, User, Vote) :-
  920	must_be(oneof([-1,1]), Vote),
  921	(   post(Post, _)
  922	->  true
  923	;   existence_error(post, Post)
  924	),
  925	(   post(Post, author, User)
  926	->  throw(error(permission_error(vote, post, Post),
  927			context(_, 'Author cannot vote')))
  928	;   true
  929	),
  930	(   findall(Old, vote(Post, Old, User, _), Votes),
  931	    sum_list([Vote|Votes], Sum),
  932	    memberchk(Sum, [-1,0,1])
  933	->  get_time(NowF),
  934	    Now is integer(NowF),
  935	    assert_vote(Post, Vote, User, Now),
  936	    post(Post, about, About),
  937	    notify(About, voted(User, Post, Vote))
  938	;   vote(Post, Vote, User, Time0),
  939	    get_time(Now),
  940	    Now - Time0 < 10		% double click or similar
  941	;   throw(error(permission_error(vote, post, Post),
  942			context(_, 'Already voted')))
  943	).
  944
  945
  946%%	vote(?PostId, ?Vote) is nondet.
  947%%	vote_up(?PostId, ?Vote) is nondet.
  948%%	vote_down(?PostId, ?Vote) is nondet.
  949%
  950%	True when PostId has been voted with   Vote. Vote is either 1 or
  951%	-1. The predicates vote_up/2 and vote_down/2   only  count up or
  952%	down votes.
  953
  954vote(PostId, Vote) :-
  955	vote(PostId, Vote, _By, _Time).
  956
  957vote_up(Post, Vote) :-
  958	vote(Post, Vote), Vote > 0.
  959
  960vote_down(Post, Vote) :-
  961	vote(Post, Vote), Vote < 0.
  962
  963%%	user_vote_count(+User, -Up, -Down) is det.
  964%
  965%	Number of votes issued by this user.
  966
  967user_vote_count(User, Up, Down) :-
  968	findall(Vote, vote(_, Vote, User, _), Votes),
  969	partition(positive, Votes, UpList, DownList),
  970	sum_list(UpList, Up),
  971	sum_list(DownList, Down).
  972
  973positive(Vote) :-
  974	Vote > 0.
  975
  976
  977		 /*******************************
  978		 *	  PROFILE SUPPORT	*
  979		 *******************************/
  980
  981%%	user_posts(+User, +Kind)//
  982%
  983%	Show posts from a specific user of the specified Kind.
  984
  985user_posts(User, Kind) -->
  986	{ find_posts(Kind, user_post(User), Ids),
  987	  Ids \== [], !,
  988	  sort_posts(Ids, SortedIds),
  989	  site_user_property(User, name(Name))
  990	},
  991	html([ \html_requires(css('annotation.css')),
  992	       h2(class(wiki), \posts_title(Kind, Name)),
  993	       table(class('user-comments'),
  994		     \list_post_summaries(SortedIds))
  995	     ]).
  996user_posts(_, _) -->
  997	[].
  998
  999user_post(User, Id) :-
 1000	post(Id, author, User).
 1001
 1002posts_title(news, Name) -->
 1003	html(['News articles by ', Name]).
 1004posts_title(annotation, Name) -->
 1005	html(['Comments by ', Name]).
 1006
 1007
 1008list_post_summaries([]) --> [].
 1009list_post_summaries([H|T]) -->		% annotation
 1010	{ post(H, object, Object), !,
 1011	  post(H, content, Comment)
 1012	},
 1013	html(tr([ td(\object_ref(Object, [])),
 1014		  td(class('comment-summary'),
 1015		     \comment_summary(Comment))
 1016		])),
 1017	list_post_summaries(T).
 1018list_post_summaries([H|T]) -->		% news article
 1019	{ post(H, content, Comment)
 1020	},
 1021	html(tr([ td(class('comment-summary'),
 1022		     [ \post_link(H), ' -- ',
 1023		       \comment_summary(Comment)
 1024		     ] )
 1025		])),
 1026	list_post_summaries(T).
 1027
 1028%%	comment_summary(+Comment)//
 1029%
 1030%	Show the first sentence or max first 80 characters of Comment.
 1031
 1032comment_summary(Comment) -->
 1033	{ summary_sentence(Comment, Summary) },
 1034	html(Summary).
 1035
 1036summary_sentence(Comment, Summary):-
 1037	atom_codes(Comment, Codes),
 1038	phrase(summary(SummaryCodes, 80), Codes, _),
 1039	atom_codes(Summary, SummaryCodes).
 1040
 1041summary([C,End], _) -->
 1042	[C,End],
 1043	{ \+ code_type(C, period),
 1044	  code_type(End, period) % ., !, ?
 1045	},
 1046	white, !.
 1047summary([0' |T0], Max) -->
 1048	blank, !,
 1049	blanks,
 1050	{Left is Max-1},
 1051	summary(T0, Left).
 1052summary(Elipsis, 0) --> !,
 1053	{ string_codes(" ...", Elipsis)
 1054	}.
 1055summary([H|T0], Max) -->
 1056	[H], !,
 1057	{Left is Max-1},
 1058	summary(T0, Left).
 1059summary([], _) -->
 1060	[].
 1061
 1062%%	user_post_count(+User, +Kind, -Count) is det.
 1063%
 1064%	True when Count is the number of posts of Kind created by User.
 1065
 1066user_post_count(User, Kind, Count) :-
 1067	find_posts(Kind, user_post(User), Annotations),
 1068	length(Annotations, Count).
 1069
 1070
 1071		 /*******************************
 1072		 *	      MESSAGES		*
 1073		 *******************************/
 1074
 1075:- multifile
 1076	mail_notify:event_subject//1,		% +Event
 1077	mail_notify:event_message//1.		% +event
 1078
 1079mail_notify:event_subject(post_created(Post)) -->
 1080	[ 'Comment by '-[] ],
 1081	msg_user(Post.meta.author).
 1082mail_notify:event_subject(post_deleted(Post)) -->
 1083	[ 'Comment removed by '-[] ],
 1084	msg_user(Post.meta.author).
 1085mail_notify:event_subject(post_updated(_OldPost, NewPost)) -->
 1086	[ 'Comment updated by '-[] ],
 1087	msg_user(NewPost.meta.author).
 1088mail_notify:event_subject(voted(User, _PostId, Vote)) -->
 1089	{ updown(Vote, UpDown) },
 1090	[ 'Voted ~w by '-[UpDown] ],
 1091	msg_user(User).
 1092
 1093mail_notify:event_message(post_created(Post)) -->
 1094	[ 'Comment by '-[] ],
 1095	msg_user(Post.meta.author), [nl],
 1096	msg_body(Post.content).
 1097mail_notify:event_message(post_deleted(Post)) -->
 1098	[ 'Comment removed by '-[] ],
 1099	msg_user(Post.meta.author), [nl],
 1100	msg_body(Post.content).
 1101mail_notify:event_message(post_updated(_OldPost, NewPost)) -->
 1102	[ 'Comment updated by '-[] ],
 1103	msg_user(NewPost.meta.author), [nl],
 1104	msg_body(NewPost.content).
 1105mail_notify:event_message(voted(User, PostId, Vote)) -->
 1106	{ updown(Vote, UpDown) },
 1107	[ '~w by '-[UpDown] ],
 1108	msg_user(User),
 1109	[ 'For'-[] ],
 1110	{ post(PostId, content, Content) },
 1111	msg_body(Content).
 1112
 1113msg_body(Body) -->
 1114	[ nl,
 1115	  '~w'-[Body],
 1116	  nl
 1117	].
 1118
 1119updown(N, Atom) :-
 1120	N > 0, !,
 1121	format(atom(Atom), '+~d', [N]).
 1122updown(Vote, Vote)