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