30
31:- module(pack_review,
32 [ pack_rating_votes/3, 33 pack_comment_count/2, 34 pack_reviews//1, 35 show_pack_rating//1, 36 show_pack_rating//5, 37 profile_reviews//1, 38 user_review_count/2 39 ]). 40:- use_module(library(http/http_dispatch)). 41:- use_module(library(http/http_parameters)). 42:- use_module(library(http/html_write)). 43:- use_module(library(http/html_head)). 44:- use_module(library(persistency)). 45:- use_module(library(aggregate)). 46:- use_module(library(record)). 47:- use_module(library(debug)). 48
49:- use_module(markitup). 50:- use_module(rating). 51:- use_module(openid). 52:- use_module(wiki). 53
54:- http_handler(root(pack/review), pack_review, []). 55:- http_handler(root(pack/review/submit), pack_submit_review, []). 56:- http_handler(root(pack/review/rating), pack_rating, []).
61 64
65:- persistent
66 review(pack:atom,
67 user:atom, 68 time:number,
69 rating:integer,
70 comment:atom). 71
72:- initialization
73 absolute_file_name(data('reviews.db'), File,
74 [ access(write) ]),
75 db_attach(File, []). 76
77
78
86pack_review(Request) :-
87 site_user(Request, UUID),
88 http_parameters(Request,
89 [ p(Pack, [])
90 ]),
91 http_link_to_id(pack_submit_review, [], Action),
92 reply_html_page(
93 wiki(review(Pack)),
94 title('Review pack ~w'-[Pack]),
95 [ h1('Review pack ~w'-[Pack]),
96 \explain(Pack, UUID),
97 \html_requires(css('pack.css')),
98 form([ class(review), action(Action), method('POST') ],
99 [ input([type(hidden), name(p), value(Pack)]),
100 table([ \reviewer(Request, UUID),
101 \rating(Pack, UUID),
102 \comment(Pack, UUID),
103 tr(td([colspan(2), align(right)],
104 input([ type(submit),
105 value('Submit review')
106 ])))
107 ])
108 ])
109 ]).
110
111
112explain(Pack, UUID) -->
113 { site_user_property(UUID, name(Name))
114 },
115 html([ p([ 'Dear ', Name, ', you requested to review pack ', b(Pack), '. ',
116 'The text field uses PlDoc wiki format, which is a ',
117 'superset of Markdown. You can use the two ',
118 'left-most icons to open and close a preview window.'
119 ]),
120 p([ 'Any user can have at most one review per pack. Trying ',
121 'to submit a new review will return the old review and ',
122 'allow you to update your opinion.'
123 ])
124 ]).
130reviewer(Request, UUID) -->
131 { site_user_property(UUID, name(Name)),
132 option(request_uri(RequestURI), Request),
133 http_link_to_id(create_profile, [return(RequestURI)], UpdateURL),
134 Update = a([class(update), href(UpdateURL)], 'Update profile')
135 }, !,
136 html([ tr([th('User:'), td([ input([ name(name),
137 value(Name),
138 disabled(disabled)
139 ]),
140 Update
141 ])])
142 ]).
143
144
145rating(Pack, UUID) -->
146 { http_link_to_id(pack_rating, [], HREF),
147 ( review(Pack, UUID, _, Rating0, _),
148 Rating0 > 0
149 -> Extra = [data_average(Rating0)]
150 ; Extra = [data_average(0)],
151 Rating0 = 0
152 )
153 },
154 html(tr([ th('Your rating for ~w:'-[Pack]),
155 td( [ input([type(hidden), name(rating), value(Rating0)]),
156 \rate([ on_rating(HREF),
157 data_id(Pack),
158 set_field(rating),
159 rate_max(5),
160 step(true),
161 type(big),
162 can_rate_again(true)
163 | Extra
164 ])
165 ])
166 ])).
173pack_rating(Request) :-
174 http_parameters(Request,
175 [ idBox(IdBox, []),
176 rate(Rate, [number])
177 ], []),
178 debug(rating, 'Got idBox = ~q, Rate = ~q', [IdBox,Rate]),
179 format('Content-type: text/plain\n\n'),
180 format('true\n').
181
182
(Pack, UUID) -->
184 { ( review(Pack, UUID, _, _, Comment)
185 -> Extra = [value(Comment)]
186 ; Extra = []
187 )
188 },
189 html(tr(td(colspan(2),
190 \markitup([ id(comment),
191 markup(pldoc),
192 cold(60),
193 rows(10)
194 | Extra
195 ])))).
202pack_submit_review(Request) :-
203 site_user(Request, UUID),
204 http_parameters(Request,
205 [ p(Pack, []),
206 rating(Rating, [number]),
207 comment(Comment, [optional(true), default('')])
208 ]),
209 reply_html_page(
210 wiki(review(Pack)),
211 title('Thanks for your review of ~w'-[Pack]),
212 [ \update_review(Pack, UUID, Rating, Comment)
213 ]).
220update_review(Pack, UUID, Rating, Comment) -->
221 { review(Pack, UUID, _Time, Rating, Comment) }, !,
222 html(h4(class(wiki), 'No changes, showing your existing comment')),
223 show_review(Pack, UUID),
224 refresh(Pack).
225update_review(Pack, UUID, Rating, Comment) -->
226 { review(Pack, UUID, _Time, _Rating, _Comment), !,
227 retractall_review(Pack, UUID, _, _, _),
228 get_time(TimeF),
229 Time is round(TimeF),
230 assert_review(Pack, UUID, Time, Rating, Comment)
231 },
232 html(h4(class(wiki), 'Updated your comments for pack ~w'-[Pack])),
233 show_review(Pack, UUID),
234 refresh(Pack).
235update_review(Pack, UUID, Rating, Comment) -->
236 { get_time(Time),
237 assert_review(Pack, UUID, Time, Rating, Comment)
238 },
239 html(h4(class(wiki), 'Added comment for pack ~w'-[Pack])),
240 show_review(Pack, UUID),
241 refresh(Pack).
242
243refresh(Pack) -->
244 { http_link_to_id(pack_list, [p(Pack)], ListPack),
245 Delay = 3
246 },
247 html([ 'Redirecting to pack ', a(href(ListPack), Pack),
248 ' in ~w seconds'-[Delay]
249 ]),
250 html_post(head,
251 meta([ 'http-equiv'(refresh),
252 content(Delay+';'+ListPack)
253 ])).
254
255
256
264pack_reviews(Pack) -->
265 html(h2(class(wiki), 'Reviews')),
266 show_reviews(Pack).
267
268show_reviews(Pack) -->
269 { \+ review(Pack, _, _, _, _), !,
270 http_link_to_id(pack_review, [p(Pack)], HREF)
271 },
272 html([ p([ 'No reviews. ',
273 a(href(HREF), 'Create'), ' the first review!.'
274 ])
275 ]).
276show_reviews(Pack) -->
277 { findall(review(Pack, UUID, Time, Rating, Comment),
278 ( review(Pack, UUID, Time, Rating, Comment),
279 Comment \== ''
280 ),
281 Reviews),
282 length(Reviews, Count),
283 sort_reviews(time, Reviews, Sorted)
284 },
285 html([ div(\review_action(Pack)),
286 div(class(smallprint), \showing_reviews(Count))
287 ]),
288 list_reviews(Sorted, []).
289
290review_action(Pack) -->
291 { site_user_logged_in(User),
292 review(Pack, User, Time, _Rating, _Comment),
293 http_link_to_id(pack_review, [p(Pack)], HREF)
294 }, !,
295 html([ a(href(HREF), 'Update'), ' your rating or review from ',
296 \show_time(Time), '.'
297 ]).
298review_action(Pack) -->
299 { http_link_to_id(pack_review, [p(Pack)], HREF)
300 },
301 html([ a(href(HREF), 'Write'), ' a review or add a rating.' ]).
302
303showing_reviews(Count) -->
304 { Count >= 2 },
305 html([ 'Showing ~D reviews, '-[Count],
306 'sorted by date entered, last review first. '
307 ]).
308showing_reviews(_) --> [].
309
310
311list_reviews([], _) --> [].
312list_reviews([H|T], Options) --> list_review(H, Options), list_reviews(T, Options).
313
314list_review(Review, Options) -->
315 { review_name(Review, Pack),
316 review_user(Review, UUID),
317 review_time(Review, Time),
318 review_rating(Review, Rating),
319 review_comment(Review, Comment)
320 },
321 html([ div(class(review),
322 [ div(class(rating),
323 [ \show_pack(Pack, Options),
324 \show_rating_value(Pack, Rating, [])
325 ]),
326 div(class(comment), \show_comment(Comment)),
327 div(class(reviewer), \show_reviewer(UUID, Time))
328 ])
329 ]).
330
331:- record
332 review(name:atom,
333 user:atom,
334 time:number,
335 rating:integer,
336 comment:atom). 337
338sort_reviews(By, Reviews, Sorted) :-
339 map_list_to_pairs(review_data(By), Reviews, Keyed),
340 keysort(Keyed, KeySorted),
341 pairs_values(KeySorted, Sorted0),
342 reverse(Sorted0, Sorted).
348show_review(Pack, UUID) -->
349 { review(Pack, UUID, _Time, Rating, Comment),
350 http_link_to_id(pack_review, [p(Pack)], Update),
351 http_link_to_id(pack_list, [p(Pack)], ListPack)
352 },
353 html_requires(css('pack.css')),
354 html([ div(class(review),
355 [ b('Reviewer: '), \show_reviewer(UUID), ', ',
356 b('Your rating: '), \show_rating_value(Pack, Rating, []),
357 b('Average rating: '), \show_rating(Pack),
358 div(class(comment), \show_comment(Comment)),
359 ul([ li([a(href(Update), 'Update'), ' my review']),
360 li([a(href(ListPack), 'View'), ' pack ', Pack])
361 ])
362 ])
363 ]).
368show_pack(Pack, Options) -->
369 { option(show_pack(true), Options), !,
370 http_link_to_id(pack_list, [p(Pack)], HREF)
371 },
372 html(span(['Pack: ', a(href(HREF), Pack)])).
373show_pack(_, _) --> [].
378show_reviewer(UUID) -->
379 { site_user_property(UUID, name(Name)),
380 http_link_to_id(view_profile, [user(UUID)], HREF),
381 Name \== '',
382 aggregate_all(count,
383 ( review(_, UUID, _, _, Comment), Comment \== '' ),
384 Comments),
385 aggregate_all(count-sum(Rating),
386 ( review(_, UUID, _, Rating, _), Rating > 0 ),
387 Ratings-Sum),
388 ( Ratings > 0
389 -> Avg is Sum/Ratings,
390 format(atom(Title), '~D comments, ~D ratings (avg ~1f)',
391 [Comments, Ratings, Avg])
392 ; format(atom(Title), '~D comments', [Comments])
393 )
394 }, !,
395 html(a([class(user), href(HREF), title(Title)], Name)).
396show_reviewer(_UUID) -->
397 html(i(anonymous)).
401show_reviewer(UUID, Time) -->
402 show_time(Time),
403 html(', '),
404 show_reviewer(UUID).
405
406show_time(Time) -->
407 { format_time(atom(Date), '%A %d %B %Y', Time)
408 },
409 html(Date).
410
411show_rating(Pack) -->
412 { pack_rating_votes(Pack, Rating, Votes),
413 pack_comment_count(Pack, Count)
414 },
415 show_pack_rating(Pack, Rating, Votes, Count, []).
421show_pack_rating(Pack) -->
422 { pack_rating_votes(Pack, Rating, Votes) },
423 ( { Votes =:= 0 }
424 -> { http_link_to_id(pack_review, [p(Pack)], HREF) },
425 html(span(class(not_rated),
426 [ 'Not rated. ', a(href(HREF), 'Create'),
427 ' the first rating!'
428 ]))
429 ; { pack_comment_count(Pack, Count) },
430 show_pack_rating(Pack, Rating, Votes, Count, [])
431 ).
438pack_rating_votes(Pack, Rating, Votes) :-
439 aggregate_all(count-sum(R), pack_rating(Pack, R), Votes-Sum),
440 Votes > 0, !,
441 Rating is Sum/Votes.
442pack_rating_votes(_Pack, 0, 0).
443
444pack_rating(Pack, Rating) :-
445 review(Pack, _, _, Rating, _),
446 Rating > 0.
452pack_comment_count(Pack, Count) :-
453 aggregate_all(count,
454 ( review(Pack, _, _, _, Comment),
455 Comment \== ''
456 ),
457 Count).
458
459
460show_rating_value(Pack, Value, Options) -->
461 rate([ rate_max(5),
462 data_id(Pack),
463 type(small),
464 disabled(true),
465 class(rated),
466 post(script),
467 data_average(Value)
468 | Options
469 ]).
476show_pack_rating(Pack, Rating, 0, 0, Options) --> !,
477 show_rating_value(Pack, Rating, Options).
478show_pack_rating(Pack, Rating, Votes, Count, Options) -->
479 html(span(class(rating),
480 [ \show_rating_value(Pack, Rating, Options),
481 span(class(votes), ' (~D/~D)'-[Votes, Count])
482 ])).
488show_comment('') --> !,
489 html(i('No comment')).
490show_comment(Text) -->
491 { atom_codes(Text, Codes),
492 wiki_file_codes_to_dom(Codes, /, DOM0),
493 clean_dom(DOM0, DOM)
494 },
495 html(DOM).
496
497clean_dom([p(X)], X) :- !.
498clean_dom(X, X).
499
500
501
509profile_reviews(UUID) -->
510 { findall(review(Pack, UUID, Time, Rating, Comment),
511 review(Pack, UUID, Time, Rating, Comment),
512 Reviews),
513 Reviews \== [], !,
514 length(Reviews, Count),
515 sort_reviews(time, Reviews, Sorted),
516 site_user_property(UUID, name(Name))
517 },
518 html_requires(css('pack.css')),
519 html([ h2(class(wiki), 'Reviews by ~w'-[Name]),
520 p([ \showing_reviews(Count)
521 ])
522 ]),
523 list_reviews(Sorted, [show_pack(true)]).
524profile_reviews(_) -->
525 [].
532user_review_count(UUID, Count) :-
533 aggregate_all(count, review(_, UUID, _, _, _), Count)
Handle rating and reviewing of packages
*/