1:- module(bc_type, [
    2    bc_register_type/5,
    3    bc_unregister_type/1,
    4    bc_register_preview/2,
    5    bc_unregister_preview/1,
    6    bc_type/5,
    7    bc_type_preview/2,
    8    bc_register_canonical/2,
    9    bc_unregister_canonical/1,
   10    bc_type_canonical/2
   11]).   12
   13:- use_module(library(debug)).   14:- use_module(library(error)).   15
   16:- use_module(bc_role).   17
   18:- dynamic(type/5).   19:- dynamic(preview/2).   20:- dynamic(canonical/2).

 bc_type(Name, Label, MenuLabel, Roles, Comments) is nondet

Matches/generates all registered types.

   26bc_type(Name, Label, MenuLabel, Roles, Comments):-
   27    type(Name, Label, MenuLabel, Roles, Comments).

 bc_type_preview(Name, Preview) is nondet

Matches/generates all registered type previews.

   33bc_type_preview(Name, Preview):-
   34    preview(Name, Preview).

 bc_type_preview(Name, Canonical) is nondet

Matches/generates all registered type canonical URLs.

   40bc_type_canonical(Name, Canonical):-
   41    canonical(Name, Canonical).

 bc_register_type(+Name, +Label, +MenuLabel, +Roles, +Comments) is det

Registers a new type. Overwrites existing type.

   47bc_register_type(Name, Label, MenuLabel, Roles, Comments):-
   48    must_be(atom, Name),
   49    must_be(atom, Label),
   50    must_be(atom, MenuLabel),
   51    check_roles(Roles),
   52    check_roles_duplicate(Roles),
   53    (   type(Name, _, _, _, _)
   54    ->  retractall(type(Name, _, _, _, _))
   55    ;   true),
   56    assertz(type(Name, Label, MenuLabel, Roles, Comments)),
   57    debug(bc_type, 'type ~w registered', [Name]).

 bc_unregister_type(+Name) is det

Removes the given type. Does nothing when the type does not exist already.

   64bc_unregister_type(Name):-
   65    must_be(atom, Name),
   66    retractall(type(Name, _, _, _, _)).

 bc_register_preview(+Name, +Preview) is det

Registers a new type preview. Overwrites existing preview.

   72bc_register_preview(Name, Preview):-
   73    must_be(atom, Name),
   74    must_be(atom, Preview),
   75    (   sub_atom(Preview, _, _, _, '<slug>')
   76    ->  true
   77    ;   throw(error(invalid_preview(Preview), _))),
   78    (   preview(Name, _)
   79    ->  retractall(preview(Name, _))
   80    ;   true),
   81    assertz(preview(Name, Preview)),
   82    debug(bc_type,
   83        'type ~w preview URL ~w registered',
   84        [Name, Preview]).

 bc_unregister_preview(+Name) is det

Removes the given type preview. Does nothing when the preview does not exist.

   91bc_unregister_preview(Name):-
   92    must_be(atom, Name),
   93    retractall(preview(Name, _)).

 bc_unregister_canonical(+Name) is det

Removes the given type canonical URL.

   99bc_unregister_canonical(Name):-
  100    must_be(atom, Name),
  101    retractall(canonical(Name, _)).

 bc_register_canonical(+Name, +Canonical) is det

Registers a new type canonical URL. Overwrites old one.

  108bc_register_canonical(Name, Canonical):-
  109    must_be(atom, Name),
  110    must_be(atom, Canonical),
  111    (   sub_atom(Canonical, _, _, _, '<slug>')
  112    ->  true
  113    ;   throw(error(invalid_canonical(Canonical), _))),
  114    (   canonical(Name, _)
  115    ->  retractall(canonical(Name, _))
  116    ;   true),
  117    assertz(canonical(Name, Canonical)),
  118    debug(bc_type,
  119        'type ~w canonical URL ~w registered',
  120        [Name, Canonical]).
  121
  122% Checks that type gets valid
  123% access roles.
  124
  125check_roles([]).
  126
  127check_roles([Role|Roles]):-
  128    check_role(Role),
  129    check_roles(Roles).
  130
  131% Checks that there are no
  132% duplicate roles.
  133
  134check_roles_duplicate(Roles):-
  135    maplist(role_name, Roles, Names),
  136    sort(Names, Sorted),
  137    length(Names, Len),
  138    length(Sorted, Len).
  139
  140check_roles_duplicate(_):-
  141    throw(error(duplicate_roles)).
  142
  143role_name(Role, Name):-
  144    Role =.. [Name|_].
  145
  146check_role(Role):-
  147    Role =.. [Name|Grants],
  148    check_role_exists(Name),
  149    check_grants(Grants).
  150
  151check_role_exists(Name):-
  152    bc_role(Name, _, _), !.
  153
  154check_role_exists(_):-
  155    throw(error(role_not_exists)).
  156
  157check_grants([Grant|Grants]):-
  158    check_grant(Grant),
  159    check_grants(Grants).
  160
  161check_grants([]).
  162
  163check_grant(Grant):-
  164    nonvar(Grant),
  165    memberchk(Grant, [create, read_own, update_own, remove_own,
  166        read_any, update_any, remove_any, publish_own, publish_any, files]), !.
  167
  168check_grant(_):-
  169    throw(error(invalid_grant))