{-# LANGUAGE NoImplicitPrelude #-}

module Tendermint.SDK.BaseApp.Store.Map
  ( Map
  , makeMap
  , makeFullStoreKey
  , insert
  , lookup
  , delete
  , update
  ) where

import           Control.Lens                          ((^.))
import           Data.Kind                             (Type)
import           Polysemy                              (Member, Members, Sem)
import           Polysemy.Error                        (Error)
import           Prelude                               hiding (lookup)
import           Tendermint.SDK.BaseApp.Errors         (AppError)
import qualified Tendermint.SDK.BaseApp.Store.RawStore as S
import           Tendermint.SDK.Codec                  (HasCodec (..))

data Map (k :: Type) (v :: Type) = Map
  { Map k v -> Store (Map k v)
mapStore :: S.Store (Map k v)
  }

instance S.RawKey k => S.IsKey k (Map k v) where
  type Value k (Map k v) = v

makeMap
  :: S.IsKey key ns
  => S.Value key ns ~ Map k v
  => key
  -> S.Store ns
  -> S.Value key ns
makeMap :: key -> Store ns -> Value key ns
makeMap key :: key
key store :: Store ns
store =
  let skr :: S.KeyRoot (Map k v)
      skr :: KeyRoot (Map k v)
skr = ByteString -> KeyRoot (Map k v)
forall k (ns :: k). ByteString -> KeyRoot ns
S.KeyRoot (ByteString -> KeyRoot (Map k v))
-> ByteString -> KeyRoot (Map k v)
forall a b. (a -> b) -> a -> b
$ key
key key -> Getting ByteString key ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString key ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey
  in Store (Map k v) -> Value key ns
forall k v. Store (Map k v) -> Map k v
Map (Store (Map k v) -> Value key ns)
-> Store (Map k v) -> Value key ns
forall a b. (a -> b) -> a -> b
$ Store ns -> Store (Map k v) -> Store (Map k v)
forall k1 k2 (parentns :: k1) (childns :: k2).
Store parentns -> Store childns -> Store childns
S.nestStore Store ns
store (KeyRoot (Map k v) -> Store (Map k v)
forall k (ns :: k). KeyRoot ns -> Store ns
S.makeStore KeyRoot (Map k v)
forall k v. KeyRoot (Map k v)
skr)

makeFullStoreKey
  :: S.RawKey k
  => Map k v
  -> k
  -> S.StoreKey
makeFullStoreKey :: Map k v -> k -> StoreKey
makeFullStoreKey Map{..} =
  Store (Map k v) -> k -> StoreKey
forall k1 k2 (ns :: k1). IsKey k2 ns => Store ns -> k2 -> StoreKey
S.makeStoreKey Store (Map k v)
mapStore

insert
  :: Member S.WriteStore r
  => S.RawKey k
  => HasCodec v
  => k
  -> v
  -> Map k v
  -> Sem r ()
insert :: k -> v -> Map k v -> Sem r ()
insert k :: k
k v :: v
v Map{..} =
  Store (Map k v) -> k -> Value k (Map k v) -> Sem r ()
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns), Member WriteStore r) =>
Store ns -> k2 -> Value k2 ns -> Sem r ()
S.put Store (Map k v)
mapStore k
k v
Value k (Map k v)
v

lookup
  :: Members [Error AppError, S.ReadStore] r
  => S.RawKey k
  => HasCodec v
  => k
  -> Map k v
  -> Sem r (Maybe v)
lookup :: k -> Map k v -> Sem r (Maybe v)
lookup k :: k
k Map{..} =
  Store (Map k v) -> k -> Sem r (Maybe (Value k (Map k v)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (Map k v)
mapStore k
k

delete
  :: Member S.WriteStore r
  => S.RawKey k
  => k
  -> Map k v
  -> Sem r ()
delete :: k -> Map k v -> Sem r ()
delete k :: k
k Map{..} =
  Store (Map k v) -> k -> Sem r ()
forall k1 k2 (ns :: k1) (r :: [(* -> *) -> * -> *]).
(IsKey k2 ns, Member WriteStore r) =>
Store ns -> k2 -> Sem r ()
S.delete Store (Map k v)
mapStore k
k

update
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => S.RawKey k
  => HasCodec v
  => (v -> Maybe v)
  -> k
  -> Map k v
  -> Sem r ()
update :: (v -> Maybe v) -> k -> Map k v -> Sem r ()
update f :: v -> Maybe v
f k :: k
k store :: Map k v
store = do
  Maybe v
mv <- k -> Map k v -> Sem r (Maybe v)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
lookup k
k Map k v
store
  case Maybe v
mv of
    Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just v :: v
v  -> Sem r () -> (v -> Sem r ()) -> Maybe v -> Sem r ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k -> Map k v -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k) =>
k -> Map k v -> Sem r ()
delete k
k Map k v
store) (\a :: v
a -> k -> v -> Map k v -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
insert k
k v
a Map k v
store) (v -> Maybe v
f v
v)