View source with formatted comments or as raw
    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): 2013-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(news,
   31	  [ random_news//0
   32	  ]).   33:- use_module(generics).   34:- use_module(library(aggregate)).   35:- use_module(library(random)).   36:- use_module(library(http/html_head)).   37:- use_module(library(http/html_write)).   38:- use_module(library(http/http_dispatch)).   39:- use_module(library(pldoc/doc_html)).   40:- use_module(post).   41
   42:- html_resource(css('news.css'), [requires([css('post.css')])]).   43
   44:- http_handler(root(news), news_process, [prefix]).   45:- http_handler(root(news/archive), news_archive, []).   46
   47/** <module> News on the SWI-Prolog Web site
   48
   49@author Wouter Beek
   50@tbd Calculate relevance based on freshness lifetime and importance.
   51@tbd User-specific influencing of relevance. Based on login/based on cookies.
   52@version 2013/12
   53*/
   54
   55
   56
   57
   58%%	news_process(+Request)
   59%
   60%	HTTP handler for /news/.  Distinguishes three cases:
   61%
   62%	  1. GET to /news/<Kind>/<Id> to render a single news item.
   63%	  2. GET to /news/ to render the _fresh_ news.
   64%	  3. POST provides a REST API for managing news.
   65
   66news_process(Request) :-			% list specific article
   67	memberchk(method(get), Request),
   68	request_to_id(Request, news, Post),
   69	Post \== '', !,
   70	post(Post, title, Title1),
   71	post(Post, kind, Kind),
   72	(   post(Post, object, Object)
   73	->  true
   74	;   Object = null
   75	),
   76	atomic_list_concat(['News',Title1], ' -- ', Title2),
   77	reply_html_page(
   78	    news(Post),
   79	    title(Title2),
   80	    [ \post(Post, []),
   81	      \news_backlink(Kind, Object)
   82	    ]).
   83news_process(Request) :-			% list fresh news
   84	memberchk(method(get), Request), !,
   85	find_posts(news, fresh, Ids),
   86	Title = 'News',
   87	reply_html_page(
   88	    news(fresh),
   89	    title(Title),
   90	    [ \html_requires(css('news.css')),
   91	      \posts(news, null, Ids,
   92		     [ order_by(created),
   93		       add_add_link(false)
   94		     ]),
   95	      \news_archive_link(news, Ids),
   96	      \add_post_link(news, null)
   97	    ]).
   98news_process(Request) :-			% handle editing news
   99	post_process(Request, news).
  100
  101news_archive_link(Kind, Ids) -->
  102	{ find_posts(Kind, all, All),
  103	  length(All, Total)
  104	},
  105	(   { length(Ids, Total) }
  106	->  []
  107	;   { http_link_to_id(news_archive, [], HREF)
  108	    },
  109	    html(div(class('news-archive-link'),
  110		     a(href(HREF), 'View all ~D news articles'-[Total])))
  111	).
  112
  113
  114%%	news_archive(+Request) is det.
  115%
  116%	Show all available news.
  117
  118news_archive(_Request):-
  119	find_posts(news, all, Ids),
  120
  121	reply_html_page(
  122	    news(all),
  123	    title('News archive'),
  124	    [ \posts(news, null, Ids,
  125		     [ order_by(created),
  126		       add_add_link(false)
  127		     ]),
  128	      \news_backlink(news, null),
  129	      \add_post_link(news, null)
  130	    ]).
  131
  132news_backlink(news, _Object) --> !,
  133	{ http_link_to_id(news_process, [], Link) },
  134	html(a(href=Link, 'Back to fresh news items')).
  135news_backlink(_Kind, Object) -->
  136	html('View annotation in context of '),
  137	object_ref(Object, [style(title)]).
  138
  139%!	random_news// is semidet.
  140%
  141%	Emit a random news item for the Did You Know place of the page.
  142%	Fails if there is no news.
  143
  144random_news -->
  145	{ random_new_item(Id, Title),
  146	  http_link_to_id(news_process, path_postfix(Id), Link)
  147	},
  148	html([ span(class(lbl), 'News: '),
  149	       span(id(dyknow), a(href=Link, Title))
  150	     ]).
  151
  152%% random_new_item(-Id:atom, -Title:atom) is det.
  153
  154random_new_item(Id, Title):-
  155	aggregate_all(
  156	    sum(Relevance),
  157	    ( post(Id, kind, news),
  158	      relevance(Id, Relevance)
  159	    ),
  160	    SummedRelevance),
  161	random(0.0, SummedRelevance, R),
  162	find_posts(news, fresh, Ids),
  163	random_new_item(0.0, R, Ids, Id, Title).
  164
  165random_new_item(_V, _R, [Id], Id, Title):- !,
  166	post(Id, title, Title).
  167random_new_item(V1, R, [Id|_], Id, Title):-
  168	relevance(Id, Relevance),
  169	V2 is V1 + Relevance,
  170	R =< V2, !,
  171	post(Id, title, Title).
  172random_new_item(V1, R, [Id0|Ids], Id, Title):-
  173	relevance(Id0, Relevance),
  174	V2 is V1 + Relevance,
  175	random_new_item(V2, R, Ids, Id, Title)