1:- module(bc_api_comment, []).    2
    3:- use_module(library(dict_schema)).    4:- use_module(library(arouter)).    5
    6:- use_module(bc_view).    7:- use_module(bc_api_io).    8:- use_module(bc_api_auth).    9:- use_module(bc_api_error).   10:- use_module(bc_api_actor).   11:- use_module(bc_data_comment).   12:- use_module(bc_comment_question).   13
   14% Comments of a single post.
   15% For admin interface.
   16
   17:- route_get(api/post/Id/comments,
   18    bc_auth, comment_tree(Id)).   19
   20comment_tree(PostId):-
   21    bc_comment_tree(PostId, Comments),
   22    bc_reply_success(Comments).
   23
   24% Adds new comment. This is available for
   25% everyone.
   26
   27:- route_post(api/post/Id/comment,
   28    bc_call_handle_error, comment_save(Id)).   29
   30comment_save(PostId):-
   31    bc_read_by_schema(bc_comment, Comment),
   32    bc_comment_save(PostId, Comment, CommentId),
   33    bc_view_purge_cache,
   34    bc_reply_success(CommentId).
   35
   36% Removes the given comment.
   37
   38:- route_del(api/comment/EntryId/Id,
   39    bc_auth, comment_remove(EntryId, Id)).   40
   41comment_remove(EntryId, Id):-
   42    bc_actor(Actor),
   43    bc_comment_remove(Actor, EntryId, Id),
   44    bc_view_purge_cache,
   45    bc_reply_success(Id).
   46
   47% Human test question. Used in
   48% comment form.
   49
   50:- route_get(api/question, comment_question).   51
   52comment_question:-
   53    bc_random_question(Id, Question),
   54    bc_reply_success(_{ id: Id, question: Question }).
   55
   56% Basic comments. Can be overriden to
   57% add more properties.
   58
   59:- register_schema(bc_comment, _{
   60    type: dict,
   61    tag: comment,
   62    keys: _{
   63        author: _{ type: string, min_length: 1 },
   64        content: _{ type: string, min_length: 1 },
   65        reply_to: _{ type: atom, min_length: 1 },
   66        email: _{ type: string, min_length: 1 },
   67        site: _{ type: string, min_length: 1 },
   68        question: integer,
   69        answer: atom,
   70        notify: bool
   71    },
   72    optional: [ reply_to, email, site, notify ]
   73}).