1:- module(bc_action, [
    2    bc_register_action/6,   % +Name, +Label, +Icon, +Type, +Role, :Closure
    3    bc_execute_access_id/3, % +Actor, +Action, +EntryId
    4    bc_execute/4,           % +Actor, +Action, +EntryId, -Result
    5    bc_available_actions/3  % +Actor, +Id, -Actions
    6]).    7
    8:- use_module(library(error)).    9
   10:- use_module(bc_type).   11:- use_module(bc_role).   12:- use_module(bc_entry).   13
   14:- dynamic(action/6).   15
   16:- meta_predicate(bc_register_action(+, +, +, +, +, 3)).
 bc_register_action(+Name, +Label, Icon, +Type, +Role, :Closure) is det
Registers a new action.
   22bc_register_action(Name, Label, Icon, Type, Role, Closure):-
   23    must_be(atom, Name),
   24    must_be(atom, Label),
   25    must_be(atom, Icon),
   26    must_be(atom, Type),
   27    must_be(atom, Role),
   28    (   action(Name, _, _, _, _, _)
   29    ->  retractall(action(Name, _, _, _, _, _))
   30    ;   true),
   31    assertz(action(Name, Label, Icon, Type, Role, Closure)),
   32    debug(bc_action, 'action ~w registered', [Name]).
 bc_execute_access_id(+Actor, +Action, +EntryId) is semidet
Checks whether the actor has execute access for the given action on the entry.
   39bc_execute_access_id(Actor, _, _):-
   40    Actor.type = admin, !.
   41
   42bc_execute_access_id(Actor, Action, EntryId):-
   43    bc_entry_type(EntryId, Type),
   44    action(Action, _, _, Type, Actor.type, _).
   45
   46% TODO: comment.
   47
   48bc_execute(Actor, Action, EntryId, Result):-
   49    (   action(Action, _, _, _, _, Closure)
   50    ->  run_closure(Closure, Actor, EntryId, Result)
   51    ;   throw(error(no_action))).
   52
   53run_closure(Closure, Actor, EntryId, Result):-
   54    catch_with_backtrace(
   55        call(Closure, Actor, EntryId, Result),
   56        Error,
   57        print_message(error, Error)),
   58    (   nonvar(Error)
   59    ->  !, throw(error(action_failed))
   60    ;   true).
   61
   62run_closure(_, _, _, _):-
   63    throw(error(action_failed)).
 bc_available_actions(+Actor, +Id, -Actions) is det
Find the list of available actions for the entry.
   69bc_available_actions(Actor, _, Actions):-
   70    Actor.type = admin, !,
   71    all_actions(Actions).
   72
   73bc_available_actions(Actor, Id, Actions):-
   74    bc_entry_type(Id, Type),
   75    role_type_actions(Actor.type, Type, Actions).
   76
   77role_type_actions(Role, Type, Actions):-
   78    findall(
   79        _{ name: Name, label: Label, icon: Icon, type: Type },
   80        action(Name, Label, Icon, Type, Role, _),
   81        Actions).
   82
   83all_actions(Actions):-
   84    findall(
   85        _{ name: Name, label: Label, icon: Icon, type: Type },
   86        action(Name, Label, Icon, Type, _, _),
   87        Actions)