%% @private -module(lee_storage). -include("lee_internal.hrl"). -export([ new/2 , new/1 , get/2 , patch/2 , list/2 , fold/3 , fold/4 , dump/1 , clone/3 ]). %% Internal exports: -export([wrap/2]). -export_type([ data/1 , data/0 , patch/1 ]). %%==================================================================== %% Types %%==================================================================== -define(rose_tree, '$rose_tree'). -type storage(_A) :: term(). -type patch(A) :: [{set, lee:key(), A} | {rm, lee:key()}]. -type rose_tree() :: #{lee:key() => rose_tree()}. -record(lee_tree, { %% Callback module implementing key-value storage: backend %% Key-value storage for values (grants us fast `get'): , data }). -type data(A) :: #lee_tree{ backend :: module() , data :: storage(A | rose_tree()) }. -type data() :: data(term()). %%==================================================================== %% Callbacks %%==================================================================== -callback create(Options :: term()) -> storage(_). -callback get(term(), storage(Val)) -> {ok, Val} | undefined. -callback patch(Storage, Delete, Set) -> Storage when Storage :: storage(Val) , Delete :: [lee:key()] , Set :: [{lee:key(), Val}]. %%==================================================================== %% API function %%==================================================================== -spec new(module(), map()) -> data(_). new(Backend, Options) -> Data0 = Backend:create(Options), Data = Backend:patch(Data0, [], [{?rose_tree, #{}}]), #lee_tree{ backend = Backend , data = Data }. -spec new(module()) -> data(_). new(Module) -> new(Module, #{}). -spec get(lee:key(), data(A)) -> {ok, A} | undefined. get(Key, #lee_tree{backend = Backend, data = Data}) -> Backend:get(Key, Data). -spec patch(data(A), patch(A)) -> data(A). patch(D0 = #lee_tree{backend = Backend, data = Data0}, Patch0) -> {ok, Keys0} = Backend:get(?rose_tree, Data0), {Delete, Set} = transform_patch(D0, Patch0), Keys1 = lists:foldl(fun rt_del/2, Keys0, Delete), Keys = lists:foldl(fun rt_add/2, Keys1, [K || {K, _} <- Set]), Data = Backend:patch(Data0, Delete, [{?rose_tree, Keys} | Set]), D0#lee_tree{ data = Data }. %% @doc List instances that can match the pattern -spec list(lee:key(), data(_)) -> [lee:key()]. list(Pattern, #lee_tree{backend = Backend, data = Data}) -> {ok, Keys} = Backend:get(?rose_tree, Data), list(Keys, [], Pattern). -spec fold( fun((lee:key(), Val, Acc) -> Acc) , Acc , data(Val) ) -> Acc. fold(Fun0, Acc0, Data) -> Fun = fun(Key, Val, Acc, _) -> {Fun0(Key, Val, Acc), ?unused} end, fold(Fun, Acc0, ?unused, Data). -spec fold( fun((lee:key(), Val, Acc, Scope) -> {Acc, Scope}) , Acc , Scope , data(Val) ) -> Acc. fold(Fun0, Acc0, Scope0, Data) -> #lee_tree{ data = Storage , backend = Backend } = Data, {ok, Keys} = Backend:get(?rose_tree, Storage), Fun = fun(Key, Acc, Scope) -> case Backend:get(Key, Storage) of {ok, Val} -> Fun0(Key, Val, Acc, Scope); undefined -> {Acc, Scope} end end, rt_fold(Fun, Acc0, Scope0, Keys, []). %% @doc Wrap a persistent storage. Hacky -spec wrap(module(), term()) -> data(term()). wrap(Backend, Blob) -> #lee_tree{backend = Backend, data = Blob}. %% @doc Dump contents of the storage to a patch -spec dump(data(A)) -> patch(A). dump(S) -> fold( fun(K, V, Acc) -> [{set, K, V} | Acc] end , [] , S). %% @doc Clone contents of the storage into another new storage -spec clone(data(A), module(), map()) -> data(A). clone(A, Backend, BackendOpts) -> patch(new(Backend, BackendOpts), dump(A)). %%==================================================================== %% Rose tree operations %%==================================================================== -spec rt_add(lee:key(), rose_tree()) -> rose_tree(). rt_add([A], Tree) -> case Tree of #{A := _} -> Tree; _ -> Tree #{A => #{}} end; rt_add([A|B], Tree) -> Children0 = maps:get(A, Tree, #{}), Children = rt_add(B, Children0), Tree #{A => Children}. -spec rt_del(lee:key(), rose_tree()) -> rose_tree(). rt_del([A], Tree) -> case Tree of #{A := Children} -> case maps:size(Children) of 0 -> maps:without([A], Tree); _ -> error({A, Tree}) end; _ -> Tree end; rt_del([A|B], Tree) -> case Tree of #{A := Children} -> Tree #{A => rt_del(B, Children)}; _ -> Tree end. rt_fold(Fun, Acc, Scope, Tree) -> rt_fold(Fun, Acc, Scope, Tree, []). rt_fold(Fun, Acc0, Scope0, Keys, Prefix0) -> maps:fold( fun(K, Children, Acc1) -> Prefix = Prefix0 ++ [K], {Acc, Scope} = Fun(Prefix, Acc1, Scope0), rt_fold(Fun, Acc, Scope, Children, Prefix) end , Acc0 , Keys ). -spec rt_list_children(lee:key(), rose_tree()) -> [lee:key()]. rt_list_children(Parent, Tree) -> rt_fold( fun(Key, Acc, _) -> {[Parent ++ Key|Acc], ?unused} end , [Parent] , ?unused , goto(Parent, Tree) ). %%==================================================================== %% Internal functions %%==================================================================== -spec transform_patch(data(A), patch(A)) -> {[lee:key()], [{lee:key(), A}]}. transform_patch(#lee_tree{backend = Backend, data = Data}, Patch) -> {ok, Tree} = Backend:get(?rose_tree, Data), {Del0, Set} = separate_patch_operations(Patch, {[], []}), Del1 = lists:append([rt_list_children(I, Tree) || I <- Del0]), %% TODO: Optimize me %% Reverse lexicographic order ensures that children get deleted %% before parents: Del = lists:reverse(lists:sort(Del1)), {Del, Set}. separate_patch_operations([], Acc) -> Acc; separate_patch_operations([{rm, K} | Rest], {Del, Set}) -> separate_patch_operations(Rest, {[K | Del], Set}); separate_patch_operations([{set, K, V} | Rest], {Del, Set}) -> separate_patch_operations(Rest, {Del, [{K, V} | Set]}). -spec goto(lee:key(), rose_tree()) -> rose_tree(). goto([], Tree) -> Tree; goto([A|Rest], Tree) -> case Tree of #{A := T} -> goto(Rest, T); _ -> #{} end. -spec list(rose_tree(), lee:key(), lee:key()) -> [lee:key()]. list(_, Prefix, []) -> [lists:reverse(Prefix)]; list(Keys, Prefix, [?children|Rest]) -> lists:append([ list(V, [K | Prefix], Rest) || {K, V} <- maps:to_list(Keys) ]); list(Keys, Prefix, [K|Rest]) -> case Keys of #{K := V} -> list(V, [K | Prefix], Rest); _ -> [] end.