1:- module(bc_entry, [
    2    bc_entry_exists/1,     % +Id
    3    bc_entry_author/2,     % +Id, -AuthorId
    4    bc_entry_title/2,      % +Id, -Title
    5    bc_entry_type/2,       % +Id, -Type
    6    bc_entry_published/2,  % +Id, -Published
    7    bc_entry_commenting/2, % +Id, -Commenting
    8    bc_entry_slug/2,       % +Id, -Slug
    9    bc_valid_slug/1,       % +Slug
   10    bc_slug_id/2,          % +Slug, -Id
   11    bc_slug_unique/1,      % +Slug
   12    bc_slug_unique/2       % +Slug, +Id
   13]).   14
   15:- use_module(library(docstore)).   16
   17% FIXME document
   18
   19bc_entry_author(Id, AuthorId):-
   20    (   ds_col_get(entry, Id, [author], Entry)
   21    ;   ds_col_get(trash, Id, [author], Entry)), !,
   22    Entry.author = AuthorId.
   23
   24bc_entry_title(Id, Title):-
   25    (   ds_col_get(entry, Id, [title], Entry)
   26    ;   ds_col_get(trash, Id, [title], Entry)), !,
   27    Entry.title = Title.
   28
   29bc_entry_type(Id, Type):-
   30    (   ds_col_get(entry, Id, [type], Entry)
   31    ;   ds_col_get(trash, Id, [type], Entry)), !,
   32    Entry.type = Type.
   33
   34bc_entry_published(Id, Published):-
   35    (   ds_col_get(entry, Id, [published], Entry)
   36    ;   ds_col_get(trash, Id, [published], Entry)), !,
   37    Entry.published = Published.
   38
   39bc_entry_commenting(Id, Commenting):-
   40    (   ds_col_get(entry, Id, [commenting], Entry)
   41    ;   ds_col_get(trash, Id, [commenting], Entry)), !,
   42    Entry.commenting = Commenting.
   43
   44bc_entry_slug(Id, Slug):-
   45    (   ds_col_get(entry, Id, [slug], Entry)
   46    ;   ds_col_get(trash, Id, [slug], Entry)), !,
   47    Entry.slug = Slug.
   48
   49% Finds entry id by slug.
   50% Also looks into trash.
   51
   52bc_slug_id(Slug, Id):-
   53    (   ds_find(entry, slug=Slug, [slug], [Entry])
   54    ;   ds_find(trash, slug=Slug, [slug], [Entry])), !,
   55    ds_id(Entry, Id).
   56
   57% Checks that slug is not used before.
   58
   59bc_slug_unique(Slug):-
   60    \+ bc_slug_id(Slug, _), !.
   61
   62bc_slug_unique(_):-
   63    throw(error(existing_slug)).
   64
   65% Checks that slug is not used
   66% for another post.
   67
   68bc_slug_unique(Slug, _):-
   69    \+ bc_slug_id(Slug, _), !.
   70
   71bc_slug_unique(Slug, Id):-
   72    bc_slug_id(Slug, Id), !.
   73
   74bc_slug_unique(_, _):-
   75    throw(error(existing_slug)).
   76
   77% Checks that the given
   78% entry exists.
   79
   80bc_entry_exists(Id):-
   81    bc_entry_type(Id, _), !.
   82
   83bc_entry_exists(_):-
   84    throw(error(entry_not_exists)).
   85
   86% Checks that the given slug
   87% is valid. Must only contain
   88% lowercase ascii, hyphen and underscore.
   89
   90bc_valid_slug(Slug):-
   91    atom_length(Slug, Len),
   92    Len > 0,
   93    atom_codes(Slug, Codes),
   94    maplist(allowed_slug_code, Codes), !.
   95
   96bc_valid_slug(_):-
   97    throw(error(invalid_slug)).
   98
   99allowed_slug_code(0'-).
  100
  101allowed_slug_code(0'_).
  102
  103allowed_slug_code(Code):-
  104    Code >= 0'a, Code =< 0'z.
  105
  106allowed_slug_code(Code):-
  107    Code >= 0'0, Code =< 0'9