1:- module(bc_data_mail, [
    2    bc_mail_unsubscribe_entry/1, % +CommentId
    3    bc_mail_unsubscribe_all/1    % +CommentId
    4]).    5
    6:- use_module(library(debug)).    7:- use_module(library(docstore)).

Mail-specific data operations */

   11bc_mail_unsubscribe_entry(CommentId):-
   12    must_be(atom, CommentId),
   13    ds_col_get(comment, CommentId, Comment),
   14    debug(bc_mail, 'unsubscribe ~w from ~w comments',
   15        [Comment.email, Comment.post]),
   16    ds_find(comment,
   17        (post=Comment.post, email=Comment.email),
   18        [], Comments),
   19    ds_transactional(maplist(disable_notify, Comments)).
   20
   21bc_mail_unsubscribe_all(CommentId):-
   22    must_be(atom, CommentId),
   23    ds_col_get(comment, CommentId, Comment),
   24    debug(bc_mail, 'unsubscribe ~w from all comments',
   25        [Comment.email]),
   26    ds_find(comment, email=Comment.email,
   27        [], Comments),
   28    ds_transactional(maplist(disable_notify, Comments)).
   29
   30disable_notify(Comment):-
   31    ds_id(Comment, CommentId),
   32    ds_update(CommentId, _{ notify: false })