1:- module(bc_user, [
    2    bc_valid_username/1,  % +Username
    3    bc_unique_username/1, % +Username
    4    bc_unique_username/2, % +Username, +Id
    5    bc_user_exists/1,     % +Id
    6    bc_remaining_admin/1, % +Id
    7    bc_no_entries/1,      % +Id
    8    bc_valid_role/1       % +Name
    9]).   10
   11:- use_module(library(dcg/basics)).   12:- use_module(library(docstore)).   13
   14:- use_module(bc_role).   15
   16% Checks that the user's username
   17% is an email address.
   18
   19bc_valid_username(Username):-
   20    atom_codes(Username, Codes),
   21    phrase(email, Codes, []), !.
   22
   23bc_valid_username(_):-
   24    throw(error(invalid_username)).
   25
   26email -->
   27    string_without(`@`, Start), "@", string_without(`@`, End),
   28    {   length(Start, LenStart), LenStart > 0,
   29        length(End, LenEnd), LenEnd > 0 }.
   30
   31% Checks that username is
   32% not used before.
   33
   34bc_unique_username(Username):-
   35    \+ bc_username_id(Username, _), !.
   36
   37bc_unique_username(_):-
   38    throw(error(existing_username)).
   39
   40% Checks that username is
   41% not used by other users.
   42
   43bc_unique_username(Username, _):-
   44    \+ bc_username_id(Username, _), !.
   45
   46bc_unique_username(Username, Id):-
   47    bc_username_id(Username, Id), !.
   48
   49bc_unique_username(_, _):-
   50    throw(error(existing_username)).
   51
   52% Checks that the user's role
   53% is valid.
   54
   55bc_valid_role(Name):-
   56    bc_role(Name, _, _), !.
   57
   58bc_valid_role(_):-
   59    throw(error(invalid_role)).
   60
   61% Checks that there is
   62% a remaining admin after
   63% the user is not admin anymore.
   64
   65bc_remaining_admin(Id):-
   66    ds_find(user, type=admin, [type], Users),
   67    member(User, Users),
   68    User.'$id' \= Id, !.
   69
   70bc_remaining_admin(_):-
   71    throw(error(no_remaining_admin)).
   72
   73% Checks that the user
   74% has no entries.
   75
   76bc_no_entries(Id):-
   77    ds_find(entry, author=Id, [author], Entries),
   78    length(Entries, 0), !.
   79
   80bc_no_entries(_):-
   81    throw(error(has_entries)).
   82
   83% Checks that the user exists.
   84
   85bc_user_exists(Id):-
   86    ds_col_get(user, Id, [type], _), !.
   87
   88bc_user_exists(_):-
   89    throw(error(user_not_exists)).
   90
   91% Finds user id by username.
   92
   93bc_username_id(Username, Id):-
   94    ds_find(user, username=Username, [username], [User]),
   95    ds_id(User, Id)