%% @author Marc Worrell <marc@worrell.nl>
%% @copyright 2009 Marc Worrell
%% Date: 2009-04-09
%%
%% @doc Model for predicates
%% Copyright 2009 Marc Worrell
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-module(m_predicate).
-author("Marc Worrell <marc@worrell.nl").
-behaviour(zotonic_model).
%% interface functions
-export([
m_get/3,
is_predicate/2,
is_used/2,
id_to_name/2,
name_to_id/2,
objects/2,
subjects/2,
all/1,
get/2,
insert/2,
flush/1,
update_noflush/4,
object_category/2,
subject_category/2,
for_subject/2
]).
-include_lib("zotonic.hrl").
%% @doc Fetch the value for the key from a model source
-spec m_get( list(), zotonic_model:opt_msg(), z:context() ) -> zotonic_model:return().
m_get([], _Msg, Context) ->
{ok, {all(Context), []}};
m_get([ <<"all">> | Rest ], _Msg, Context) ->
{ok, {all(Context), Rest}};
m_get([ <<"is_used">>, Pred | Rest ], _Msg, Context) ->
{ok, {is_used(Pred, Context), Rest}};
m_get([ <<"object_category">>, Key | Rest ], _Msg, Context) ->
{ok, {object_category(Key, Context), Rest}};
m_get([ <<"subject_category">>, Key | Rest ], _Msg, Context) ->
{ok, {subject_category(Key, Context), Rest}};
m_get([ <<"is_valid_object_subcategory">>, Predicate, Category | Rest ], _Msg, Context) ->
IsValid = is_valid_object_category(Predicate, Category, true, Context),
{ok, {IsValid, Rest}};
m_get([ <<"is_valid_object_category">>, Predicate, Category | Rest ], _Msg, Context) ->
IsValid = is_valid_object_category(Predicate, Category, false, Context),
{ok, {IsValid, Rest}};
m_get([ <<"is_valid_subbject_subcategory">>, Predicate, Category | Rest ], _Msg, Context) ->
IsValid = is_valid_subject_category(Predicate, Category, true, Context),
{ok, {IsValid, Rest}};
m_get([ <<"is_valid_subbject_category">>, Predicate, Category | Rest ], _Msg, Context) ->
IsValid = is_valid_subject_category(Predicate, Category, false, Context),
{ok, {IsValid, Rest}};
m_get([ Key | Rest ], _Msg, Context) ->
{ok, {get(Key, Context), Rest}};
m_get(_Vs, _Msg, _Context) ->
{error, unknown_path}.
%% @doc Test if the property is the name of a predicate
%% @spec is_predicate(Pred, Context) -> bool()
is_predicate(Id, Context) when is_integer(Id) ->
case m_rsc:p_no_acl(Id, category_id, Context) of
undefined -> false;
CatId -> m_category:is_a(CatId, predicate, Context)
end;
is_predicate(Pred, Context) ->
case m_rsc:name_to_id(Pred, Context) of
{ok, Id} -> is_predicate(Id, Context);
_ -> false
end.
%% @doc Check if a predicate is actually in use for an existing edge.
is_used(Predicate, Context) ->
Id = m_rsc:rid(Predicate, Context),
z_db:q1("select id from edge where predicate_id = $1 limit 1", [Id], Context) =/= undefined.
is_valid_object_category(Predicate, Category, IsSubcats, Context) ->
CatId = m_rsc:rid(Category, Context),
ValidCats = object_category(Predicate, Context),
case lists:member({CatId}, ValidCats) of
true ->
true;
false when ValidCats =:= [] ->
true;
false when IsSubcats ->
IsA = m_category:is_a(CatId, Context),
lists:any(
fun(IsACat) ->
IsACatId = m_rsc:rid(IsACat, Context),
lists:member({IsACatId}, ValidCats)
end,
IsA);
false ->
false
end.
is_valid_subject_category(Predicate, Category, IsSubcats, Context) ->
CatId = m_rsc:rid(Category, Context),
ValidCats = subject_category(Predicate, Context),
case lists:member({CatId}, ValidCats) of
true ->
true;
false when ValidCats =:= [] ->
true;
false ->
IsA = m_category:is_a(CatId, Context),
case lists:any(
fun(IsACat) ->
IsACatId = m_rsc:rid(IsACat, Context),
lists:member({IsACatId}, ValidCats)
end,
IsA)
of
true ->
true;
false when IsSubcats ->
% Check subcategories
SubCats = m_category:tree_flat(CatId, Context),
SubCatIds = lists:map(
fun(C) -> proplists:get_value(id, C) end,
SubCats),
lists:any(
fun(CId) -> lists:member({CId}, ValidCats) end,
SubCatIds);
false ->
false
end
end.
%% @doc Lookup the name of a predicate with an id
-spec id_to_name(m_rsc:resource_id(), z:context()) -> {ok, atom()} | {error, {unknown_predicate, term()}}.
id_to_name(Id, Context) when is_integer(Id) ->
F = fun() ->
{L, R} = cat_bounds(Context),
case z_db:q1("
select r.name
from rsc r
join hierarchy c
on r.category_id = c.id and c.name = '$category'
where r.id = $1
and $2 <= c.nr
and c.nr <= $3", [Id, L, R], Context) of
undefined -> {error, {unknown_predicate, Id}};
Name -> {ok, z_convert:to_atom(Name)}
end
end,
z_depcache:memo(F, {predicate_name, Id}, ?DAY, [predicate], Context).
%% @doc Return the id of the predicate
-spec name_to_id( m_rsc:resource_name(), z:context() ) -> {ok, m_rsc:resource_id()} | {error, {unknown_predicate, term()}}.
name_to_id(Name, Context) ->
case m_rsc:name_to_id(Name, Context) of
{ok, Id} ->
case is_predicate(Id, Context) of
true -> {ok, Id};
false -> {error, {unkown_predicate, Id}}
end;
_ -> {error, {unknown_predicate, Name}}
end.
%% @doc Return the definition of the predicate
-spec get( atom() | m_rsc:resource_id() | string() | binary(), z:context() ) -> list() | undefined.
get(PredId, Context) when is_integer(PredId) ->
case id_to_name(PredId, Context) of
{error, _} -> undefined;
{ok, Name} -> get(Name, Context)
end;
get(Pred, Context) when is_list(Pred) orelse is_binary(Pred) ->
get(z_convert:to_atom(z_string:to_lower(Pred)), Context);
get(Pred, Context) ->
case z_depcache:get(predicate, Pred, Context) of
{ok, undefined} ->
undefined;
{ok, Value} ->
Value;
undefined ->
proplists:get_value(Pred, all(Context))
end.
%% @doc Return the category ids that are valid as objects
objects(Id, Context) ->
Objects = z_db:q("
select category_id
from predicate_category
where predicate_id = $1
and is_subject = false",
[Id], Context),
[R || {R} <- Objects].
%% @doc Return the category ids that are valid as subjects
subjects(Id, Context) ->
Subjects = z_db:q("
select category_id
from predicate_category
where predicate_id = $1
and is_subject = true",
[Id], Context),
[R || {R} <- Subjects].
%% @doc Return the list of all predicates
%% @spec all(Context) -> PropList
all(Context) ->
F = fun() ->
{L, R} = cat_bounds(Context),
Preds = z_db:assoc_props("
select *
from rsc r
join hierarchy c
on r.category_id = c.id and c.name = '$category'
where $1 <= c.nr
and c.nr <= $2
order by r.name", [L, R], Context),
FSetPred = fun(Pred) ->
Id = proplists:get_value(id, Pred),
Atom = case proplists:get_value(name, Pred) of
undefined -> undefined;
B -> list_to_atom(binary_to_list(B))
end,
{Atom, [{pred, Atom}, {subject, subjects(Id, Context)}, {object, objects(Id, Context)} | Pred]}
end,
[FSetPred(Pred) || Pred <- Preds]
end,
z_depcache:memo(F, predicate, ?DAY, Context).
%% @doc Insert a new predicate, sets some defaults.
-spec insert(binary()|list(), z:context()) -> {ok, integer()} | {error, any()}.
insert(Title, Context) ->
Name = z_string:to_name(Title),
Uri = "http://zotonic.net/predicate/" ++ Name,
Props = #{
<<"title">> => Title,
<<"name">> => Name,
<<"uri">> => Uri,
<<"category">> => predicate,
<<"group">> => admins,
<<"is_published">> => true
},
case m_rsc:insert(Props, Context) of
{ok, Id} ->
flush(Context),
{ok, Id};
{error, Reason} ->
{error, Reason}
end.
%% @doc Flush all cached data about predicates.
flush(Context) ->
z_depcache:flush(predicate, Context).
%% @doc Reset the list of valid subjects and objects.
-spec update_noflush(integer(), list(), list(), z:context()) -> ok.
update_noflush(Id, Subjects, Objects, Context) ->
SubjectIds0 = [m_rsc:rid(N, Context) || N <- Subjects, N /= [], N /= <<>>],
ObjectIds0 = [m_rsc:rid(N, Context) || N <- Objects, N /= [], N /= <<>>],
SubjectIds = [N || N <- SubjectIds0, N =/= undefined],
ObjectIds = [ N || N <- ObjectIds0, N =/= undefined ],
ok = z_db:transaction(
fun(Ctx) ->
update_predicate_category(Id, true, SubjectIds, Ctx),
update_predicate_category(Id, false, ObjectIds, Ctx),
ok
end,
Context).
update_predicate_category(Id, IsSubject, CatIds, Context) ->
OldIdsR = z_db:q("select category_id from predicate_category where predicate_id = $1 and is_subject = $2",
[Id, IsSubject], Context),
OldIds = [N || {N} <- OldIdsR],
% Delete the ones that are not there anymore
[z_db:q("delete from predicate_category where predicate_id = $1 and category_id = $2 and is_subject = $3",
[Id, OldId, IsSubject], Context)
|| OldId <- OldIds, not lists:member(OldId, CatIds)
],
[z_db:insert(predicate_category, [{predicate_id, Id}, {category_id, NewId}, {is_subject, IsSubject}],
Context)
|| NewId <- CatIds, not lists:member(NewId, OldIds)
],
ok.
%% @doc Return all the valid categories for objects.
%% Return the empty list when there is no constraint.
%% Note that the resulting array is a bit strangely formatted
%% [{id}, {id2}, ...], this is compatible with the category name lookup and
%% prevents mixups with strings (lists of integers).
%% @spec object_category(Id, Context) -> List
object_category(Id, Context) ->
F = fun() ->
case name_to_id(Id, Context) of
{ok, PredId} ->
z_db:q(
"select category_id from predicate_category where predicate_id = $1 and "
++ "is_subject = false",
[PredId], Context);
_ ->
[]
end
end,
z_depcache:memo(F, {object_category, Id}, ?WEEK, [predicate], Context).
%% @doc Return all the valid categories for subjects.
%% Return the empty list when there is no constraint.
%% Note that the resulting array is a bit strangely formatted [{id}, {id2}, ...],
%% this is compatible with the category name lookup and prevents mixups with
%% strings (lists of integers).
%% @spec subject_category(Id, Context) -> List
subject_category(Id, Context) ->
F = fun() ->
case name_to_id(Id, Context) of
{ok, PredId} ->
z_db:q("select category_id from predicate_category where predicate_id = $1 "
"and is_subject = true",
[PredId], Context);
_ ->
[]
end
end,
z_depcache:memo(F, {subject_category, Id}, ?WEEK, [predicate], Context).
%% @doc Return the list of predicates that are valid for the given resource id.
%% Append all predicates that have no restrictions.
for_subject(Id, Context) ->
F = fun() ->
{L, R} = cat_bounds(Context),
ValidIds = z_db:q("
select p.predicate_id
from predicate_category p,
hierarchy pc,
rsc r,
hierarchy rc
where p.category_id = pc.id
and pc.name = '$category'
and r.category_id = rc.id
and rc.name = '$category'
and rc.nr >= pc.lft
and rc.nr <= pc.rght
and r.id = $1
and is_subject = true
", [Id], Context),
Valid = [ValidId || {ValidId} <- ValidIds],
NoRestrictionIds = z_db:q("
select r.id
from rsc r left join predicate_category p on p.predicate_id = r.id and p.is_subject = true
join hierarchy c on (r.category_id = c.id and c.name = '$category')
where p.predicate_id is null
and $1 <= c.nr and c.nr <= $2
", [L, R], Context),
NoRestriction = [NoRestrictionId || {NoRestrictionId} <- NoRestrictionIds],
Valid ++ NoRestriction
end,
z_depcache:memo(F, {predicate_for_subject, Id}, ?WEEK, [predicate, category, Id], Context).
%% @doc Return the id of the predicate category
-spec cat_id(#context{}) -> integer().
cat_id(Context) ->
{ok, Id} = m_category:name_to_id(predicate, Context),
Id.
-spec cat_bounds(#context{}) -> {integer(), integer()}.
cat_bounds(Context) -> m_category:get_range(cat_id(Context), Context).
