Propagate cache stats from ets operations and fix dialyzer issues

.gitignore

@@ -16,3 +16,4 @@ doc/doc
 tests/
 /erl_cache
 .rebar3
+TEST-*.xml

src/erl_cache.erl

@@ -91,7 +91,7 @@
                   | wait_until_done | evict_interval | error_validity | is_error_callback
                   | mem_check_interval | key_generation.
 
--type callback() :: function() | mfa() | {function(), [any()]}.
+-type callback() :: function() | {module(), atom(), [term()]} | {function(), [term()]}.
 
 -export_type([
         name/0, key/0, value/0, validity/0, evict/0, evict_interval/0, refresh_callback/0,
@@ -165,7 +165,7 @@ set_cache_defaults(Name, CacheOpts) ->
     end.
 
 %% @doc Gets the default value of a cache server option.
--spec get_cache_option(name(), cache_opts()) -> term().
+-spec get_cache_option(name(), config_key()) -> term().
 %% @end
 get_cache_option(Name, Opt) ->
     case ets:lookup(?CACHE_MAP, Name) of

src/erl_cache_decorator.erl

@@ -1,31 +1,52 @@
 -module(erl_cache_decorator).
+-behaviour(erl_cache_key_generator).
 
 -export([cache_pt/3]).
+-export([generate_key/4]).
 
 %% ====================================================================
 %% API
 %% ====================================================================
-
--spec cache_pt(function(), [term()], {atom(), atom(), erl_cache:name(), erl_cache:cache_opts()}) ->
-    (fun(() -> term())).
+-spec cache_pt(Fun, Args, Decoration) -> Arity0Fun when
+      Fun::function(),
+      Args::[term()],
+      Decoration::{Module::module(), FunctionAtom::atom(), Name, Opts},
+      Name::erl_cache:name(),
+      Opts::erl_cache:cache_opts(),
+      Arity0Fun::fun(() -> term()).
 cache_pt(Fun, Args, {Module, FunctionAtom, Name, Opts}) ->
-    FinalOpts = [{refresh_callback, fun () -> Fun(Args) end} | Opts],
-    Key = case proplists:get_value(key_generation, Opts) of
-        KeyModule when is_atom(KeyModule), KeyModule /= undefined ->
-            apply(KeyModule, generate_key, [Name, Module, FunctionAtom, Args]);
-        _ ->
-            {decorated, Module, FunctionAtom, crypto:hash(sha, erlang:term_to_binary(Args))}
-    end,
-    FromCache = erl_cache:get(Name, Key, FinalOpts),
-    case FromCache of
-        {ok, Result} -> fun() -> Result end;
+    KeyModule = key_module(Opts),
+    Key = KeyModule:generate_key(Name, Module, FunctionAtom, Args),
+    case erl_cache:get(Name, Key, Opts) of
+        {ok, Result} ->
+            fun() -> Result end;
         {error, not_found} ->
-            fun () ->
-                    Res = Fun(Args),
-                    ok = erl_cache:set(Name, Key, Res, FinalOpts),
-                    Res
-            end;
+            cache_setter(Name, Key, Opts, Fun, Args);
         {error, Err} ->
             throw({error, {cache_pt, Err}})
     end.
 
+%% ====================================================================
+%% Behaviour callback
+%% ====================================================================
+generate_key(_Name,  Module, FunctionAtom, Args) ->
+    {decorated, Module, FunctionAtom, crypto:hash(sha, erlang:term_to_binary(Args))}.
+
+%% ====================================================================
+%% Internal
+%% ====================================================================
+key_module(Opts) ->
+    case proplists:get_value(key_generation, Opts) of
+        undefined -> ?MODULE;
+        KeyMod when is_atom(KeyMod) -> KeyMod;
+        _ -> ?MODULE
+    end.
+
+cache_setter(Name, Key, Opts, Fun, Args) ->
+    Callback = fun() -> Fun(Args) end,
+    SetOpts = [{refresh_callback, Callback} | Opts],
+    fun() ->
+            Value = Callback(),
+            ok = erl_cache:set(Name, Key, Value, SetOpts),
+            Value
+    end.

src/erl_cache_key_generator.erl

@@ -7,5 +7,9 @@
 %%
 %% The way to fix this issue is modifying how erl_decorator_pt deals with the
 %% intermediate code representation.
--callback generate_key(CacheInstance::erl_cache:name(), Module::atom(),
-                       Function::atom(), Args::[term()]) -> erl_cache:key().
+-callback generate_key(Name, Module, Function, Args) -> Key when
+      Name::erl_cache:name(),
+      Module::module(),
+      Function::atom(),
+      Args::[term()],
+      Key::erl_cache:key().

src/erl_cache_server.erl

@@ -37,6 +37,7 @@
 }).
 
 -type stats() :: #stats{}.
+-type stats_field() :: hit|miss|overdue|evict|set.
 
 -record(state, {
     name  :: erl_cache:name(), %% The name of this cache instance
@@ -45,18 +46,20 @@
 }).
 
 -record(cache_entry, {
-    key::erl_cache:key(),
-    value::erl_cache:value(),
-    created::pos_integer(),
-    validity::pos_integer(),
-    evict::pos_integer(),
-    validity_delta::erl_cache:validity(),
-    error_validity_delta::erl_cache:error_validity(),
-    evict_delta::erl_cache:evict(),
-    refresh_callback::erl_cache:refresh_callback(),
-    is_error_callback::erl_cache:is_error_callback()
+    key::undefined|'_'|erl_cache:key(),
+    value::undefined|'_'|erl_cache:value(),
+    created::undefined|'_'|pos_integer(),
+    validity::undefined|'_'|pos_integer(),
+    evict::undefined|'_'|'$1'|pos_integer(),
+    validity_delta::undefined|'_'|erl_cache:validity(),
+    error_validity_delta::undefined|'_'|erl_cache:error_validity(),
+    evict_delta::undefined|'_'|erl_cache:evict(),
+    refresh_callback::undefined|'_'|erl_cache:refresh_callback(),
+    is_error_callback::undefined|'_'|erl_cache:is_error_callback()
 }).
 
+-type cache_operation()::fun((erl_cache:name(), #cache_entry{}) -> non_neg_integer()).
+
 %% ==================================================================
 %% API Function Definitions
 %% ==================================================================
@@ -138,11 +141,11 @@ set(Name, Key, Value, ValidityDelta, EvictDelta,
         refresh_callback = RefreshCb,
         is_error_callback = IsErrorCb
     },
-    operate_cache(Name, fun do_set/2, [Name, Entry], set, WaitTillSet).
+    operate_cache(Name, fun do_set/2, Entry, set, WaitTillSet).
 
 -spec evict(erl_cache:name(), erl_cache:key(), erl_cache:wait_until_done()) -> ok.
 evict(Name, Key, WaitUntilDone) ->
-    operate_cache(Name, fun do_evict/2, [Name, Key], evict, WaitUntilDone).
+    operate_cache(Name, fun do_evict/2, #cache_entry{key=Key, _='_'}, evict, WaitUntilDone).
 
 -spec get_stats(erl_cache:name()) -> erl_cache:cache_stats().
 get_stats(Name) ->
@@ -158,8 +161,7 @@ is_valid_name(Name) ->
 
 -spec evict_all(erl_cache:name(), boolean()) -> ok.
 evict_all(Name, WaitUntilDone) ->
-    Args = [Name, get_table_name(Name)],
-    operate_cache(fun do_evict_all/2, Args, WaitUntilDone).
+    operate_cache(Name, fun do_evict_all/2, #cache_entry{_='_'}, evict, WaitUntilDone).
 
 %% ==================================================================
 %% gen_server Function Definitions
@@ -219,85 +221,85 @@ code_change(_OldVsn, State, _Extra) ->
 %% ====================================================================
 
 %% @private
--spec operate_cache(erl_cache:name(), function(), list(), atom(), boolean()) -> ok.
-operate_cache(Name, Function, Input, Stat, Sync) ->
-    operate_cache(Function, Input, Sync),
-    gen_server:cast(Name, {increase_stat, Stat}).
-
-operate_cache(Function, Input, Sync) ->
-    case Sync of
-        true -> apply(Function, Input);
-        false -> spawn_link(erlang, apply, [Function, Input])
-    end,
+-spec operate_cache(Name, Function, Entry, Stat, boolean()) -> ok when
+      Name::erl_cache:name(),
+      Function::cache_operation(),
+      Entry::#cache_entry{},
+      Stat::stats_field().
+operate_cache(Name, Function, Entry, Stat, true) ->
+    N = Function(Name, Entry),
+    ok = gen_server:cast(Name, {increase_stat, Stat, N});
+operate_cache(Name, Function, Entry, Stat, false) ->
+    spawn_link(fun() -> operate_cache(Name, Function, Entry, Stat, true) end),
     ok.
 
 %% @private
--spec do_set(erl_cache:name(), #cache_entry{}) -> ok.
+-spec do_set(erl_cache:name(), #cache_entry{}) -> non_neg_integer().
 do_set(Name, Entry) ->
     true = ets:insert(get_table_name(Name), Entry),
-    ok.
+    1.
 
 %% @private
--spec do_evict(erl_cache:name(), erl_cache:key()) -> ok.
-do_evict(Name, Key) ->
+-spec do_evict(erl_cache:name(), #cache_entry{}) -> non_neg_integer().
+do_evict(Name, #cache_entry{key=Key}) ->
     true = ets:delete(get_table_name(Name), Key),
-    ok.
+    1.
 
-do_evict_all(Name, TableName) ->
-    Deleted = ets:select_delete(TableName, [{'_', [], [true]}]),
-    gen_server:cast(Name, {increase_stat, evict, Deleted}).
+-spec do_evict_all(erl_cache:name(), #cache_entry{}) -> non_neg_integer().
+do_evict_all(Name, _Entry) ->
+    ets:select_delete(get_table_name(Name), [{'_', [], [true]}]).
 
 %% @private
 -spec purge_cache(erl_cache:name()) -> ok.
 purge_cache(Name) ->
-    Now = now_ms(),
-    TableName = get_table_name(Name),
+    Owner = ets:info(get_table_name(Name), owner),
+    MatchPattern = #cache_entry{_='_'},
     %% make sure the table has not disappeared out from under us
-    case ets:info(TableName, type) of
-        undefined -> ok;
-        _ -> purge_cache( Name, TableName, Now )
-    end.
+    [operate_cache(Name, fun tc_purge_cache/2, MatchPattern, evict, true) || is_pid(Owner)],
+    ok.
 
-purge_cache( Name, TableName, Now ) ->
-    {_Time, Deleted} =
-        timer:tc( ets, select_delete,
-                  [TableName, [{#cache_entry{evict='$1', _='_'},
-                                [{'<', '$1', Now}], [true]}]] ),
+tc_purge_cache(Name, EntryPattern) ->
+    {_Time, Deleted} = timer:tc(fun do_purge_cache/2, [Name, EntryPattern]),
     ?DEBUG("~p cache purged in ~bms", [Name, _Time]),
-    gen_server:cast(Name, {increase_stat, evict, Deleted}),
-    ok.
+    Deleted.
+
+do_purge_cache(Name, EntryPattern) ->
+    Now = now_ms(),
+    MatchPattern = EntryPattern#cache_entry{evict='$1'},
+    Conditionals = [{'<', '$1', Now}],
+    ets:select_delete(get_table_name(Name), [{MatchPattern, Conditionals, [true]}]).
 
 %% @private
 -spec refresh(erl_cache:name(), #cache_entry{}, erl_cache:wait_for_refresh()) ->
-    {ok, erl_cache:value()}.
+    {true, erl_cache:value()}.
 refresh(_Name, #cache_entry{refresh_callback=undefined} = Entry, _WaitForRefresh) ->
     {true, Entry#cache_entry.value};
 refresh(Name, #cache_entry{} = Entry, true) ->
-    {true, do_refresh(Name, Entry, true)};
+    NewEntry = maybe_refresh(Name, Entry),
+    operate_cache(Name, fun do_set/2, NewEntry, set, false),
+    {true, NewEntry#cache_entry.value};
 refresh(Name, #cache_entry{} = Entry, false) ->
-    spawn(fun () -> do_refresh(Name, Entry, false) end),
+    operate_cache(Name, fun(N, E) -> do_set(N, maybe_refresh(N, E)) end, Entry, set, false),
     {true, Entry#cache_entry.value}.
 
 %% @private
--spec do_refresh(erl_cache:name(), #cache_entry{}, erl_cache:wait_for_refresh()) ->
-    erl_cache:value().
-do_refresh(Name, #cache_entry{} = Entry, WaitForRefresh) ->
-    #cache_entry{key=Key, validity_delta=ValidityDelta, evict_delta=EvictDelta,
-                 refresh_callback=Callback, is_error_callback=IsErrorCb} = Entry,
-    ?DEBUG("Refreshing overdue key ~p in cache: ~p", [Key, Name]),
-    NewVal = do_apply(Callback),
-    Now = now_ms(),
-    RefreshedEntry = case is_error_value(IsErrorCb, NewVal) of
+-spec maybe_refresh(erl_cache:name(), #cache_entry{}) -> #cache_entry{}.
+maybe_refresh(Name, #cache_entry{refresh_callback=Callback, is_error_callback=IsErrorCb} = E) ->
+    ?DEBUG("Refreshing overdue key ~p in cache: ~p", [E#cache_entry.key, Name]),
+    % Consider wraping in try-catch
+    Value = do_apply(Callback),
+    case is_error_value(IsErrorCb, Value) of
         false ->
-            Entry#cache_entry{value=NewVal, validity=Now+ValidityDelta,
-                              evict=Now+ValidityDelta+EvictDelta};
+            Now = now_ms(),
+            Validity = Now+E#cache_entry.validity_delta,
+            Evict = Validity+E#cache_entry.evict_delta,
+            E#cache_entry{value=Value, validity=Validity, evict=Evict};
         true ->
             ?NOTICE("Error refreshing ~p at ~p: ~p. Disabling auto refresh...",
-                    [Key, Name, NewVal]),
-            Entry#cache_entry{refresh_callback=undefined}
-    end,
-    ok = operate_cache(Name, fun do_set/2, [Name, RefreshedEntry], set, WaitForRefresh),
-    NewVal.
+                    [E#cache_entry.key, Name, Value]),
+            % Consider setting validity by error_validity_delta
+            E#cache_entry{refresh_callback=undefined}
+    end.
 
 %% @private
 -spec check_mem_usage(erl_cache:name()) -> ok.
@@ -324,7 +326,7 @@ check_mem_usage( Name, CurrentWords ) ->
     ok.
 
 %% @private
--spec do_apply(function() | mfa() | {function(), [any()]}) -> term().
+-spec do_apply(erl_cache:refresh_callback()) -> term().
 do_apply({M, F, A}) when is_atom(M), is_atom(F), is_list(A) ->
     apply(M, F, A);
 do_apply({F, A}) when is_function(F, length(A)) ->

test/erl_cache_eunit.erl

@@ -118,6 +118,8 @@ refresh_overdue_async_mfa() ->
     % The value should have been asynchronously refreshed
     ?assertMatch({ok, T} when is_tuple(T) andalso T/=TestValue,
                  get_from_cache(test_key, [{wait_for_refresh, false}], 10)),
+    ?assertMatch({ok, T} when is_tuple(T) andalso T/=TestValue,
+                 get_from_cache(test_key, [{wait_for_refresh, true}], 10)),
     % At this point the value should have been evicted
     ?assertEqual({error, not_found}, get_from_cache(test_key, [], 400)).