/* Part of SWI-Prolog Author: Wouter Beek & Jan Wielemaker E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org Copyright (C): 2014, VU University Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA As a special exception, if you link this library with other files, compiled with a Free Software compiler, to produce an executable, this library does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU General Public License. */ :- module(post, [ find_posts/3, % +Kind:oneof([annotation,news]) % :CheckId % -Ids:list(atom) fresh/1, % ?Id:atom all/1, % ?Id:atom post/3, % ?Post:or([atom,compound]) % ?Name:atom % ?Value post//2, % +Post, +Options posts//4, % +Kind, +Object, +Ids, +Options add_post_link//2, % +Kind, +Object relevance/2, % +Id:atom % -Relevance:between(0.0,1.0) post_process/2, % +Request:list, +Id:atom sort_posts/2, % +Ids:list(atom), -SortedIds:list(atom) user_posts//2, % +User, +KInd user_post_count/3, % +User, +Kind, -Count user_vote_count/3 % +User, -Up, -Down ]). /** Posts @author Wouter Beek @tbd Type-based JS response. After DELETE: remove that post from DOM. After POST: add that post to DOM. After PUT: update that post in DOM. */ :- use_module(library(error)). :- use_module(library(http/html_head)). :- use_module(library(http/html_write)). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_json)). :- use_module(library(http/http_path)). :- use_module(library(http/js_write)). :- use_module(library(lists)). :- use_module(library(option)). :- use_module(library(apply)). :- use_module(library(pairs)). :- use_module(library(persistency)). :- use_module(library(pldoc/doc_html)). :- use_module(library(uri)). :- use_module(library(md5)). :- use_module(library(dcg/basics)). :- use_module(library(aggregate)). :- use_module(object_support). :- use_module(openid). :- use_module(notify). :- use_module(generics). :- meta_predicate find_posts(+,1,-). :- html_resource(css('post.css'), []). :- html_resource(js('markitup/sets/pldoc/set.js'), [ requires([ js('markitup/jquery.markitup.js'), js('markitup/skins/markitup/style.css'), js('markitup/sets/pldoc/style.css') ]) ]). :- persistent post(id:atom, post:dict), vote(id:atom, % post id value:integer, % value (up:1, down:-1) user:atom, % user who voted time:integer). % time of the vote :- initialization absolute_file_name(data('post.db'), File, [ access(write) ]), db_attach(File, [sync(close)]). :- http_handler(root(vote), vote, []). :- op(100, xf, ?). post_type(post{kind:oneof([annotation,news]), title:string?, content:string, meta:meta{id:atom, author:atom, object:any?, importance:between(0.0,1.0)?, time:time{created:number, modified:number?, 'freshness-lifetime':number?}}}). %% convert_post(+Dict0, -Dict) is det. % % @error May throw type and instantiation errors. % @tbd Introduce type-testing support in library(error). convert_post(Post0, Post) :- post_type(Type), convert_dict(Type, Post0, Post). %% convert_dict(+Type, +DictIn, -DictOut) is det. convert_dict(TypeDict, Dict0, Dict) :- is_dict(TypeDict), !, dict_pairs(TypeDict, Tag, TypePairs), dict_values(TypePairs, Dict0, Pairs), dict_pairs(Dict, Tag, Pairs). convert_dict(atom, String, Atom) :- !, atom_string(Atom, String). convert_dict(oneof(Atoms), String, Atom) :- maplist(atom, Atoms), !, atom_string(Atom, String), must_be(oneof(Atoms), Atom). convert_dict(float, Number, Float) :- !, Float is float(Number). convert_dict(list(Type), List0, List) :- !, must_be(list, List0), maplist(convert_dict(Type), List0, List). convert_dict(Type, Value, Value) :- must_be(Type, Value). dict_values([], _, []). dict_values([Name-Type|TP], Dict, [Name-Value|TV]) :- dict_value(Type, Name, Dict, Value), !, dict_values(TP, Dict, TV). dict_values([_|TP], Dict, TV) :- dict_values(TP, Dict, TV). dict_value(Type?, Name, Dict, Value) :- !, get_dict(Name, Dict, Value0), Value0 \== null, convert_dict(Type, Value0, Value). dict_value(Type, Name, Dict, Value) :- convert_dict(Type, Dict.Name, Value). %% retract_post(+Id) % % Remove post Id from the database. retract_post(Id):- retract_post(Id, _). %% convert_post(+JSON, +Kind, +Id, +Author, +TimeProperty, -Post) is det. % % Convert a post object into its Prolog equivalent. convert_post(Post0, Kind, Id, Author, TimeProperty, Post) :- get_time(Now), ( atom_string(ObjectID, Post0.meta.get(about)), object_id(Object, ObjectID) -> Post1 = Post0.put(meta/object, Object) ; Post1 = Post0 ), Post2 = Post1.put(kind, Kind) .put(meta/id, Id) .put(meta/author, Author) .put(meta/time/TimeProperty, Now), convert_post(Post2, Post). %% post_url(+Id, -HREF) is det. % % True when HREF is a link to post Id. post_url(Id, HREF) :- post(Id, kind, Kind), ( kind_handler(Kind, HandlerId) -> http_link_to_id(HandlerId, path_postfix(Id), HREF) ; domain_error(kind, Kind) ). kind_handler(news, news_process). kind_handler(annotation, annotation_process). %% post_link(+Id) % % Generate a link to post Id. post_link(Id) --> { post_url(Id, HREF) }, html(a(href(HREF), \post_link_text(Id))). post_link_text(Id) --> { post(Id, title, Title) }, html(Title). post_link_text(Id) --> { post(Id, object, Object), object_label(Object, Label) }, html(Label). %% post_process(+Request, ?Kind) is det. % % HTTP handler that implements a REST interface for postings. % % @arg Kind is the type of post, and is one of =news= or % =annotation=. post_process(Request, Kind) :- request_to_id(Request, Kind, Id), must_be(oneof([news,annotation]), Kind), memberchk(method(Method), Request), ( site_user_logged_in(User) -> true ; User = anonymous ), post_process(Method, Request, Kind, User, Id). %% post_process(+Method, +Request, +Kind, +Id, +User) is det. % % Implement the REST replies. % DELETE post_process(delete, Request, Kind, User, Id) :- post_authorized(Request, User, Kind), post(Id, author, Author), !, ( ( Author == User ; site_user_property(User, granted(admin)) ) -> post(Id, about, About), retract_post(Id, OldPost), notify(About, post_deleted(OldPost)), throw(http_reply(no_content)) % 204 ; memberchk(path(Path), Request), throw(http_reply(forbidden(Path))) % 403 ). post_process(delete, Request, _, _, _) :- http_404([], Request). % GET post_process(get, _, _, _, Id):- post(Id, Post), !, reply_json(Post). post_process(get, Request, _, _, _):- http_404([], Request). % POST post_process(post, Request, Kind, User, _):- post_authorized(Request, User, Kind), catch(( http_read_json_dict(Request, Post0), uuid(Id), convert_post(Post0, Kind, Id, User, created, NewPost), assert_post(Id, NewPost) ), E, throw(http_reply(bad_request(E)))), post(Id, about, About), notify(About, post_created(NewPost)), memberchk(path(Path), Request), atom_concat(Path, Id, NewLocation), format('Location: ~w~n', [NewLocation]), reply_json(_{created:Id, href:NewLocation}, [status(201)]). % PUT post_process(put, Request, Kind, User, Id):- post_authorized(Request, User, Kind), post(Id, created, Created), catch(( http_read_json_dict(Request, Post0), convert_post(Post0.put(meta/time/created, Created), Kind, Id, User, modified, NewPost) ), E, throw(http_reply(bad_request(E)))), ( post(Id, author, Author) -> ( Author == User -> retract_post(Id, OldPost), assert_post(Id, NewPost), post(Id, about, About), notify(About, post_updated(OldPost, NewPost)), throw(http_reply(no_content)) ; memberchk(path(Path), Request), throw(http_reply(forbidden(Path))) ) ; http_404([], Request) ). :- dynamic debug_allow_all_posts/0. %% debug_posts is det % % Defeats normal authorization checking for posts, % so during development we don't need to struggle with OAuth, % emails, etc. % debug_posts :- writeln('Anyone may now debug posts'), asserta(debug_allow_all_posts). %% nodebug_posts is det % % remove the effects of debug_posts % nodebug_posts :- writeln('Back to normal post control'), retractall(debug_allow_all_posts). %% post_authorized(+Request, +User, +Kind) is det. % % @throws http_reply(forbidden(Path)) if the user is not allowed % to post. % @tbd If the user is =anonymous=, we should reply 401 instead % of 403, but we want OpenID login post_authorized(_Request, User, Kind) :- post_granted(User, Kind), !. post_authorized(Request, _User, _Kind) :- memberchk(path(Path), Request), throw(http_reply(forbidden(Path))). post_granted(_, _) :- debug_allow_all_posts. post_granted(User, Kind) :- site_user_property(User, granted(Kind)), !. post_granted(User, annotation) :- User \== anonymous. %! post(+Post, +Name:atom, -Value) is semidet. %! post(+Post, ?Name:atom, -Value) is nondet. %! post(-Post, ?Name:atom, -Value) is nondet. % % True if Post have Value for the given attribute. % % @arg If Post is given, it is either the id of a post or a dict % describing the post. When generated, Post is the (atom) % identifier of the post. post(PostOrId, Name, Value) :- nonvar(PostOrId), !, ( atom(PostOrId) -> post(PostOrId, Post) ; Post = PostOrId ), post1(Name, Post, Value), Value \== null. post(Id, Name, Value) :- post(Id, Post), post1(Name, Post, Value). post1(object, Post, Object) :- Object = Post.meta.get(object). post1(about, Post, About) :- % used for notification ( About = Post.meta.get(object) -> true ; About = Post.kind ). post1(author, Post, Author) :- Author = Post.meta.author. post1(content, Post, Content) :- Content = Post.content. post1('freshness-lifetime', Post, FreshnessLifetime ) :- FreshnessLifetime = Post.meta.time.'freshness-lifetime'. post1(id, Post, Id) :- Id = Post.meta.id. post1(importance, Post, Importance) :- Importance = Post.meta.importance. post1(kind, Post, Kind) :- Kind = Post.kind. post1(meta, Post, Meta) :- Meta = Post.meta. post1(created, Post, Posted) :- Posted = Post.meta.time.created. post1(modified, Post, Posted) :- Posted = Post.meta.time.modified. post1(time, Post, Time):- Time = Post.meta.time. post1(title, Post, Title) :- Title = Post.get(title). post1(votes, Post, Votes) :- aggregate_all(sum(Vote), vote(Post.meta.id, Vote), Votes). post1(votes_up, Post, Up) :- aggregate_all(sum(Vote), vote_up(Post.meta.id, Vote), Up). post1(votes_down, Post, Down) :- aggregate_all(sum(Vote), vote_down(Post.meta.id, Vote), Down). %! post(+Id:atom, +Options)// is det. % % Generate HTML for apost. Supported Options: % % * orientation(+Orientation:oneof([left,right])) % Orientation of the post. This is used in binary conversations % to show the different conversation parties. % * standalone(+Standalone:boolean) % Whether this post is part of multiple posts or not. post(Id, Options) --> { post(Id, kind, Kind), ( option(orientation(Orient), Options), Orient \== none -> Extra = [ style('float:'+Orient+';') ] ; Extra = [] ) }, html(article([ class([post,Kind]), id(Id) | Extra ], [ \post_header(Id, Options), \post_section(Id), \edit_delete_post(Id) ])), ( { option(standalone(true), Options, true) } -> html_requires(css('post.css')), ( { site_user_logged_in(_) } -> { post(Id, about, Object), object_id(Object, About) -> true ; About = @(null) }, html(\write_post_js(Kind, About)) ; login_post(Kind) ) ; [] ). %! post_header(+Id, +Options)// is det. % % When the post appears in isolation (option % standalone(true)), the title is not displayed. post_header(Id, O1) --> html(header([], [ \post_title(O1, Id), \post_metadata(Id), span(class='post-links-and-votes', [ \post_votes(Id), \html_receive(edit_delete(Id)) ]) ])). post_metadata(Id) --> {post(Id, kind, Kind)}, post_metadata(Kind, Id). post_metadata(annotation, Id) --> {post(Id, author, Author)}, html(span(class='post-meta', [ \user_profile_link(Author), ' said (', \post_time(Id), '):' ])). post_metadata(news, Id) --> {post(Id, author, Author)}, html(span(class='post-meta', [ 'By ', \user_profile_link(Author), ' at ', \post_time(Id) ])). post_section(Id) --> { post(Id, author, Author), post(Id, content, Content), atom_codes(Content, Codes), wiki_file_codes_to_dom(Codes, /, DOM1), clean_dom(DOM1, DOM2) }, html(section([], [ \author_image(Author), div(class='read-post', DOM2) ])). post_time(Id) --> { post(Id, created, Posted) }, !, html(\dateTime(Posted)). post_time(_) --> []. post_title(O1, Id) --> { option(standalone(false), O1, true), post(Id, title, Title), !, post_url(Id, HREF) }, html(h2(class('post-title'), a(href(HREF),Title))). post_title(_, _) --> []. post_votes(Id) --> { post(Id, votes_down, Down), format(atom(AltDown), '~d downvotes', [Down]), post(Id, votes_up, Up), format(atom(AltUp), '~d upvotes', [Up]), post(Id, votes, Amount), http_absolute_location(icons('vote_up.gif'), UpIMG, []), http_absolute_location(icons('vote_down.gif'), DownIMG, []) }, html([ a([class='post-vote-up',href=''], img([alt(AltUp),src(UpIMG),title(Up)], [])), ' ', span(class='post-vote-amount', Amount), ' ', a([class='post-vote-down',href=''], img([alt(AltDown),src(DownIMG),title(Down)], [])) ]). %% posts(+Kind, +Object, +Ids:list(atom), +Options)// % % Generate HTML for a list of posts and add a link to add new % posts. Options: % % * order_by(+Property) % Order posts by Property. Properties are defined by post/3. % * add_add_link(+Boolean) % Add link to add new posts. Default is =true=. posts(Kind, Object, Ids1, Options) --> { atomic_list_concat([Kind,component], '-', Class), default_order(Kind, DefOrder), option(order_by(OrderBy), Options, DefOrder), sort_posts(Ids1, OrderBy, Ids2) }, html_requires(css('post.css')), html([ div(class=[posts,Class], \post_list(Ids2, Kind, none)) ]), ( { option(add_add_link(true), Options, true) } -> add_post_link(Kind, Object) ; [] ). default_order(news, created). default_order(annotation, votes). post_list([], _Kind, _Orient) --> []. post_list([Id|Ids], Kind, Orient1) --> post(Id, [orientation(Orient1),standalone(false)]), {switch_orientation(Orient1, Orient2)}, post_list(Ids, Kind, Orient2). switch_orientation(left, right). switch_orientation(right, left). switch_orientation(none, none). %% add_post_link(+Kind, +Object)// % % Emit HTML that allows for adding a new post add_post_link(Kind, Object) --> { site_user_logged_in(User), post_granted(User, Kind), ( Object == null -> About = @(null) ; object_id(Object, About) ), Id = '' % empty id }, !, html(div(id='add-post', [ \add_post_link(Kind), form([id='add-post-content',style='display:none;'], table([ tr(td(\add_post_title(Id, Kind))), tr(td([ \add_post_importance(Id, Kind), \add_post_freshnesslifetime(Id, Kind) ])), tr(td(\add_post_content(Id))), tr(td(\submit_post_links(Kind))) ])), \write_post_js(Kind, About) ])). add_post_link(Kind, _) --> login_post(Kind). add_post_content(Id) --> { Id \== '', post(Id, content, Content) -> true ; Content = [] }, html(textarea([class(markItUp)], Content)). %% add_post_freshnesslifetime(+Kind) % % Add fressness menu if Kind = =news=. Freshness times are % represented as seconds. add_post_freshnesslifetime(Id, news) --> !, { Id \== '', post(Id, 'freshness-lifetime', Default) -> true ; menu(freshness, 'One month', Default) }, html([ label([], 'Freshness lifetime: '), select(class='freshness-lifetime', \options(freshness, Default)), br([]) ]). add_post_freshnesslifetime(_, _) --> []. add_post_importance(Id, news) --> !, { Id \== '', post(Id, importance, Importance) -> true ; menu(importance, 'Normal', Importance) }, html([ label([], 'Importance: '), select(class=importance, \options(importance, Importance)) ]). add_post_importance(_, _) --> []. options(Key, Default) --> { findall(Name-Value, menu(Key, Name, Value), Pairs) }, option_list(Pairs, Default). option_list([], _) --> []. option_list([Name-Value|T], Default) --> { Name == Default -> Extra = [selected(selected)] ; Extra = [] }, html(option([value(Value)|Extra], Name)), option_list(T, Default). menu(freshness, 'One year', Secs) :- Secs is 365*24*3600. menu(freshness, 'One month', Secs) :- Secs is 31*24*3600. menu(freshness, 'One week', Secs) :- Secs is 7*24*3600. menu(freshness, 'One day', Secs) :- Secs is 1*24*3600. menu(importance, 'Very high', 1.00). menu(importance, 'High', 0.75). menu(importance, 'Normal', 0.50). menu(importance, 'Low', 0.25). menu(importance, 'Very low', 0.00). add_post_link(Kind) --> html(a([id('add-post-link'),href('')], \add_post_label(Kind))). add_post_label(news) --> html('Post new article'). add_post_label(annotation) --> html('Add comment'). add_post_title(Id, news) --> !, { Id \== '', post(Id, title, Title) -> Extra = [value(Title)] ; Extra = [] }, html([ label([], 'Title: '), input([ class(title), size(70), type(text) | Extra ], []), br([]) ]). add_post_title(_, _) --> []. submit_post_links(Kind) --> html(div([ id='add-post-links',style='display:none;'], [ a([id='add-post-submit',href=''], \submit_post_label(Kind)), a([id='add-post-cancel',href=''], 'Cancel') ])). submit_post_label(news) --> html('Submit article'). submit_post_label(annotation) --> html('Submit comment'). %% edit_post_form(+Id)// % % Provide a non-displayed editor for post Id if the author of this % post is logged on. edit_post_form(Id) --> { site_user_logged_in(User), edit_post_granted(Id, User), !, post(Id, kind, Kind) }, html([ form([class='edit-post-content',style='display:none;'], table([ tr(td(\add_post_title(Id, Kind))), tr(td([ \add_post_importance(Id, Kind), \add_post_freshnesslifetime(Id, Kind) ])), tr(td(\add_post_content(Id))), tr(td(\save_post_links(Kind))) ])) ]). edit_post_form(_) --> []. edit_delete_post(Id) --> { site_user_logged_in(User), edit_post_granted(Id, User), ! }, html([ \html_post(edit_delete(Id), \edit_delete_post_link), \edit_post_form(Id) ]). edit_delete_post(_) --> []. edit_delete_post_link --> html([ ' ', a([class='edit-post-link',href=''], 'Edit'), '/', a([class='delete-post-link',href=''], 'Delete') ]). save_post_links(Kind) --> html(div([class='save-post-links',style='display:none;'], [ a([class='save-post-submit',href=''], \save_post_title(Kind)), a([class='save-post-cancel',href=''], 'Cancel') ])). save_post_title(news) --> html('Save updated article'). save_post_title(annotation) --> html('Save updated comment'). edit_post_granted(_Id, User) :- site_user_property(User, granted(admin)), !. edit_post_granted(Id, User) :- post(Id, author, Author), User == Author. %! age(+Id:atom, -Age) is det. % % True when post Id was created Age seconds ago. age(Id, Age):- post(Id, created, Posted), get_time(Now), Age is Now - Posted. %! author_image(+User:atom)// is det. author_image(User) --> { site_user_property(User, name(Name)), format(atom(Alt), 'Picture of user ~w.', [Name]), user_avatar(User, Avatar), http_link_to_id(view_profile, [user(User)], Link) }, html(a(href(Link), img([ alt(Alt), class('post-avatar'), src(Avatar), title(Name) ]))). %% user_avatar(+User, -AvatarImageLink) is det. % % @see https://en.gravatar.com/site/implement/hash/ % @see https://en.gravatar.com/site/implement/images/ user_avatar(User, URL) :- site_user_property(User, email(Email)), downcase_atom(Email, CanonicalEmail), md5_hash(CanonicalEmail, Hash, []), atom_concat('/avatar/', Hash, Path), uri_data(scheme, Components, https), uri_data(authority, Components, 'www.gravatar.com'), uri_data(path, Components, Path), uri_components(URL, Components). dateTime(TimeStamp) --> { format_time(atom(Date), '%Y-%m-%dT%H:%M:%S', TimeStamp) }, html(span([class(date),title(TimeStamp)], Date)). %! find_posts(+Kind, :CheckId, -Ids) is det. % % True when Ids is a list of all posts of Kind for which % call(CheckId, Id) is true. find_posts(Kind, CheckId, Ids):- findall(Id, ( post(Id, Post), post(Post, kind, Kind), call(CheckId, Id) ), Ids). %! fresh(+Id:atom) is semidet. % % True if post Id is considered _fresh_. fresh(Id):- post(Id, 'freshness-lifetime', FreshnessLifetime), nonvar(FreshnessLifetime), !, age(Id, Age), Age < FreshnessLifetime. fresh(_). %! all(+Id:atom) is det. % % News filter, returning all objects all(_). %! relevance(+Id:atom, -Relevance:between(0.0,1.0)) is det. % - If `Importance` is higher, then the dropoff of `Relevance` is flatter. % - `Relevance` is 0.0 if `FreshnessLifetime =< Age`. % - `Relevance` is 1.0 if `Age == 0`. relevance(Id, Relevance) :- fresh(Id), post(Id, importance, Importance), nonvar(Importance), post(Id, 'freshness-lifetime', FreshnessLifetime), nonvar(FreshnessLifetime), !, age(Id, Age), Relevance is Importance * (1 - Age / FreshnessLifetime). relevance(_, 0.0). sort_posts(Ids, SortedIds):- sort_posts(Ids, created, SortedIds). sort_posts(Ids, Property, SortedIds):- map_list_to_pairs(post_property(Property), Ids, Pairs), keysort(Pairs, SortedPairs), reverse(SortedPairs, RevSorted), pairs_values(RevSorted, SortedIds). post_property(Property, Id, Value) :- post(Id, Property, Value). %% login_post(+Kind)// % % Suggest to login or request permission to get access to the % posting facility. login_post(Kind) --> { site_user_logged_in(_), !, http_link_to_id(register, [for(Kind)], HREF) }, html({|html(HREF, Kind)||
request permission to add a new Kind post.
|}). login_post(Kind) --> html(div(class='post-login', [b(\login_link),' to add a new ',Kind,' post.'])). %% write_post_js(+Kind, +About)// % % Emit JavaScript to manage posts. write_post_js(Kind, About) --> { kind_handler(Kind, HandlerId), http_link_to_id(HandlerId, path_postfix(''), URL), http_link_to_id(vote, [], VoteURL) }, html_requires(js('markitup/sets/pldoc/set.js')), html_requires(js('post.js')), js_script({|javascript(URL,VoteURL,About)|| $(document).ready(function() { prepare_post(URL, VoteURL, About); }); |}). /******************************* * VOTING * *******************************/ %% vote(+Request) % % HTTP POST handler for handling a vote. The posted object is a % JSON object containing the post it and vote. % % Returns a JSON object holding the current number of votes. vote(Request) :- site_user_logged_in(User), !, % any logged in user can vote catch(( memberchk(method(post), Request), http_read_json_dict(Request, Dict), atom_string(Id, Dict.id), vote(Id, User, Dict.vote) ), E, throw(http_reply(bad_request(E)))), post(Id, votes, Votes), reply_json(_{votes:Votes}). vote(Request) :- memberchk(path(Path), Request), throw(http_reply(forbidden(Path))). %% vote(+PostId, +User, +Vote) is det. % % Add a vote for PostId. vote(Post, User, Vote) :- must_be(oneof([-1,1]), Vote), ( post(Post, _) -> true ; existence_error(post, Post) ), ( post(Post, author, User) -> throw(error(permission_error(vote, post, Post), context(_, 'Author cannot vote'))) ; true ), ( findall(Old, vote(Post, Old, User, _), Votes), sum_list([Vote|Votes], Sum), memberchk(Sum, [-1,0,1]) -> get_time(NowF), Now is integer(NowF), assert_vote(Post, Vote, User, Now), post(Post, about, About), notify(About, voted(User, Post, Vote)) ; vote(Post, Vote, User, Time0), get_time(Now), Now - Time0 < 10 % double click or similar ; throw(error(permission_error(vote, post, Post), context(_, 'Already voted'))) ). %% vote(?PostId, ?Vote) is nondet. %% vote_up(?PostId, ?Vote) is nondet. %% vote_down(?PostId, ?Vote) is nondet. % % True when PostId has been voted with Vote. Vote is either 1 or % -1. The predicates vote_up/2 and vote_down/2 only count up or % down votes. vote(PostId, Vote) :- vote(PostId, Vote, _By, _Time). vote_up(Post, Vote) :- vote(Post, Vote), Vote > 0. vote_down(Post, Vote) :- vote(Post, Vote), Vote < 0. %% user_vote_count(+User, -Up, -Down) is det. % % Number of votes issued by this user. user_vote_count(User, Up, Down) :- findall(Vote, vote(_, Vote, User, _), Votes), partition(positive, Votes, UpList, DownList), sum_list(UpList, Up), sum_list(DownList, Down). positive(Vote) :- Vote > 0. /******************************* * PROFILE SUPPORT * *******************************/ %% user_posts(+User, +Kind)// % % Show posts from a specific user of the specified Kind. user_posts(User, Kind) --> { find_posts(Kind, user_post(User), Ids), Ids \== [], !, sort_posts(Ids, SortedIds), site_user_property(User, name(Name)) }, html([ \html_requires(css('annotation.css')), h2(class(wiki), \posts_title(Kind, Name)), table(class('user-comments'), \list_post_summaries(SortedIds)) ]). user_posts(_, _) --> []. user_post(User, Id) :- post(Id, author, User). posts_title(news, Name) --> html(['News articles by ', Name]). posts_title(annotation, Name) --> html(['Comments by ', Name]). list_post_summaries([]) --> []. list_post_summaries([H|T]) --> % annotation { post(H, object, Object), !, post(H, content, Comment) }, html(tr([ td(\object_ref(Object, [])), td(class('comment-summary'), \comment_summary(Comment)) ])), list_post_summaries(T). list_post_summaries([H|T]) --> % news article { post(H, content, Comment) }, html(tr([ td(class('comment-summary'), [ \post_link(H), ' -- ', \comment_summary(Comment) ] ) ])), list_post_summaries(T). %% comment_summary(+Comment)// % % Show the first sentence or max first 80 characters of Comment. comment_summary(Comment) --> { summary_sentence(Comment, Summary) }, html(Summary). summary_sentence(Comment, Summary):- atom_codes(Comment, Codes), phrase(summary(SummaryCodes, 80), Codes, _), atom_codes(Summary, SummaryCodes). summary([C,End], _) --> [C,End], { \+ code_type(C, period), code_type(End, period) % ., !, ? }, white, !. summary([0' |T0], Max) --> blank, !, blanks, {Left is Max-1}, summary(T0, Left). summary(Elipsis, 0) --> !, { string_codes(" ...", Elipsis) }. summary([H|T0], Max) --> [H], !, {Left is Max-1}, summary(T0, Left). summary([], _) --> []. %% user_post_count(+User, +Kind, -Count) is det. % % True when Count is the number of posts of Kind created by User. user_post_count(User, Kind, Count) :- find_posts(Kind, user_post(User), Annotations), length(Annotations, Count). /******************************* * MESSAGES * *******************************/ :- multifile mail_notify:event_subject//1, % +Event mail_notify:event_message//1. % +event mail_notify:event_subject(post_created(Post)) --> [ 'Comment by '-[] ], msg_user(Post.meta.author). mail_notify:event_subject(post_deleted(Post)) --> [ 'Comment removed by '-[] ], msg_user(Post.meta.author). mail_notify:event_subject(post_updated(_OldPost, NewPost)) --> [ 'Comment updated by '-[] ], msg_user(NewPost.meta.author). mail_notify:event_subject(voted(User, _PostId, Vote)) --> { updown(Vote, UpDown) }, [ 'Voted ~w by '-[UpDown] ], msg_user(User). mail_notify:event_message(post_created(Post)) --> [ 'Comment by '-[] ], msg_user(Post.meta.author), [nl], msg_body(Post.content). mail_notify:event_message(post_deleted(Post)) --> [ 'Comment removed by '-[] ], msg_user(Post.meta.author), [nl], msg_body(Post.content). mail_notify:event_message(post_updated(_OldPost, NewPost)) --> [ 'Comment updated by '-[] ], msg_user(NewPost.meta.author), [nl], msg_body(NewPost.content). mail_notify:event_message(voted(User, PostId, Vote)) --> { updown(Vote, UpDown) }, [ '~w by '-[UpDown] ], msg_user(User), [ 'For'-[] ], { post(PostId, content, Content) }, msg_body(Content). msg_body(Body) --> [ nl, '~w'-[Body], nl ]. updown(N, Atom) :- N > 0, !, format(atom(Atom), '+~d', [N]). updown(Vote, Vote).