module Cleff.KVStore where

import           Cleff
import           Cleff.Error
import           Cleff.State
import           Control.Monad.Extra (fromMaybeM)
import qualified Data.HashMap.Lazy   as HL
import qualified Data.HashMap.Strict as H
import           Data.Hashable       (Hashable)
import qualified Data.IntMap.Lazy    as IL
import qualified Data.IntMap.Strict  as I
import qualified Data.Map            as O
import qualified Data.Map.Lazy       as OL
import           Data.Maybe          (isJust)

-- * Effect

-- | An effect that provides operations of accessing a key-value store, like a map data structure or a key-value
-- database.
data KVStore k v :: Effect where
  LookupKV :: k -> KVStore k v m (Maybe v)
  UpdateKV :: k -> Maybe v -> KVStore k v m ()

-- * Operations

makeEffect ''KVStore

-- | Write a value to the given entry.
writeKV :: KVStore k v :> es => k -> v -> Eff es ()
writeKV :: k -> v -> Eff es ()
writeKV k
k = k -> Maybe v -> Eff es ()
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Maybe v -> Eff es ()
updateKV k
k (Maybe v -> Eff es ()) -> (v -> Maybe v) -> v -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
forall a. a -> Maybe a
Just

-- | Delete the given entry.
deleteKV :: forall k v es. KVStore k v :> es => k -> Eff es ()
deleteKV :: k -> Eff es ()
deleteKV k
k = k -> Maybe v -> Eff es ()
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Maybe v -> Eff es ()
updateKV k
k (Maybe v -> Eff es ()) -> Maybe v -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Maybe v
forall a. Maybe a
Nothing @v

-- | Lookup the value of the given key, if not found, then throw some error.
lookupOrThrowKV :: '[KVStore k v, Error e] :>> es => (k -> e) -> k -> Eff es v
lookupOrThrowKV :: (k -> e) -> k -> Eff es v
lookupOrThrowKV k -> e
f k
k = Eff es v -> Eff es (Maybe v) -> Eff es v
forall (m :: Type -> Type) a. Monad m => m a -> m (Maybe a) -> m a
fromMaybeM (e -> Eff es v
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
e -> Eff es a
throwError (e -> Eff es v) -> e -> Eff es v
forall a b. (a -> b) -> a -> b
$ k -> e
f k
k) (Eff es (Maybe v) -> Eff es v) -> Eff es (Maybe v) -> Eff es v
forall a b. (a -> b) -> a -> b
$ k -> Eff es (Maybe v)
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
lookupKV k
k

-- | Sees if the key is present in the store.
existsKV :: forall k v es. KVStore k v :> es => k -> Eff es Bool
existsKV :: k -> Eff es Bool
existsKV = (Maybe v -> Bool) -> Eff es (Maybe v) -> Eff es Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe v -> Bool
forall a. Maybe a -> Bool
isJust (Eff es (Maybe v) -> Eff es Bool)
-> (k -> Eff es (Maybe v)) -> k -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
lookupKV @k @v

-- | If the key is present, changes the value via a function.
adjustKV :: forall k v es. KVStore k v :> es => (v -> v) -> k -> Eff es ()
adjustKV :: (v -> v) -> k -> Eff es ()
adjustKV v -> v
f k
k = k -> Eff es (Maybe v)
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
lookupKV k
k Eff es (Maybe v) -> (Maybe v -> Eff es ()) -> Eff es ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe v
Nothing -> () -> Eff es ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
  Just v
x  -> k -> v -> Eff es ()
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> v -> Eff es ()
writeKV k
k (v -> Eff es ()) -> v -> Eff es ()
forall a b. (a -> b) -> a -> b
$ v -> v
f v
x

-- | If the key is present, updates the entry (potentially deleting it) via a function.
modifyKV :: forall k v es. KVStore k v :> es => (v -> Maybe v) -> k -> Eff es ()
modifyKV :: (v -> Maybe v) -> k -> Eff es ()
modifyKV v -> Maybe v
f k
k = k -> Eff es (Maybe v)
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
lookupKV k
k Eff es (Maybe v) -> (Maybe v -> Eff es ()) -> Eff es ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe v
Nothing -> () -> Eff es ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
  Just v
x  -> k -> Maybe v -> Eff es ()
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Maybe v -> Eff es ()
updateKV k
k (Maybe v -> Eff es ()) -> Maybe v -> Eff es ()
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
f v
x

-- | Updates the entry via a function, no matter the key is present or not.
alterKV :: forall k v es. KVStore k v :> es => (Maybe v -> Maybe v) -> k -> Eff es ()
alterKV :: (Maybe v -> Maybe v) -> k -> Eff es ()
alterKV Maybe v -> Maybe v
f k
k = k -> Eff es (Maybe v)
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Eff es (Maybe v)
lookupKV k
k Eff es (Maybe v) -> (Maybe v -> Eff es ()) -> Eff es ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= k -> Maybe v -> Eff es ()
forall k v (es :: [(Type -> Type) -> Type -> Type]).
(KVStore k v :> es) =>
k -> Maybe v -> Eff es ()
updateKV k
k (Maybe v -> Eff es ())
-> (Maybe v -> Maybe v) -> Maybe v -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe v -> Maybe v
f

-- * Interpretations

-- | Interpret a 'KVStore' effect in terms of 'O.Map' and strict operations.
kvStoreToMapState :: Ord k => Eff (KVStore k v ': es) ~> Eff (State (O.Map k v) ': es)
kvStoreToMapState :: Eff (KVStore k v : es) ~> Eff (State (Map k v) : es)
kvStoreToMapState = Handler (KVStore k v) '[State (Map k v)] es
-> Eff (KVStore k v : es) ~> Eff (State (Map k v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (Map k v -> Maybe v) -> Eff (State (Map k v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
O.lookup k
k)
  UpdateKV k v -> (Map k v -> Map k v) -> Eff (State (Map k v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> k -> Map k v -> Map k v
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
O.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) k
k)
{-# INLINE kvStoreToMapState #-}

-- | Interpret a 'KVStore' effect in terms of 'OL.Map' and lazy operations.
kvStoreToLazyMapState :: Ord k => Eff (KVStore k v ': es) ~> Eff (State (OL.Map k v) ': es)
kvStoreToLazyMapState :: Eff (KVStore k v : es) ~> Eff (State (Map k v) : es)
kvStoreToLazyMapState = Handler (KVStore k v) '[State (Map k v)] es
-> Eff (KVStore k v : es) ~> Eff (State (Map k v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (Map k v -> Maybe v) -> Eff (State (Map k v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
OL.lookup k
k)
  UpdateKV k v -> (Map k v -> Map k v) -> Eff (State (Map k v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> k -> Map k v -> Map k v
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
OL.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) k
k)
{-# INLINE kvStoreToLazyMapState #-}

-- | Interpret a @'KVStore' 'Int' v@ effect in terms of 'I.IntMap' and strict operations.
kvStoreToIntMapState :: Eff (KVStore I.Key v ': es) ~> Eff (State (I.IntMap v) ': es)
kvStoreToIntMapState :: Eff (KVStore Key v : es) a -> Eff (State (IntMap v) : es) a
kvStoreToIntMapState = Handler (KVStore Key v) '[State (IntMap v)] es
-> Eff (KVStore Key v : es) ~> Eff (State (IntMap v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (IntMap v -> Maybe v) -> Eff (State (IntMap v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (Key -> IntMap v -> Maybe v
forall a. Key -> IntMap a -> Maybe a
I.lookup Key
k)
  UpdateKV k v -> (IntMap v -> IntMap v) -> Eff (State (IntMap v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> Key -> IntMap v -> IntMap v
forall a. (a -> Maybe a) -> Key -> IntMap a -> IntMap a
I.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) Key
k)
{-# INLINE kvStoreToIntMapState #-}

-- | Interpret a @'KVStore' 'Int' v@ effect in terms of 'IL.IntMap' and lazy operations.
kvStoreToLazyIntMapState :: () => Eff (KVStore IL.Key v ': es) ~> Eff (State (IL.IntMap v) ': es)
kvStoreToLazyIntMapState :: Eff (KVStore Key v : es) a -> Eff (State (IntMap v) : es) a
kvStoreToLazyIntMapState = Handler (KVStore Key v) '[State (IntMap v)] es
-> Eff (KVStore Key v : es) ~> Eff (State (IntMap v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (IntMap v -> Maybe v) -> Eff (State (IntMap v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (Key -> IntMap v -> Maybe v
forall a. Key -> IntMap a -> Maybe a
IL.lookup Key
k)
  UpdateKV k v -> (IntMap v -> IntMap v) -> Eff (State (IntMap v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> Key -> IntMap v -> IntMap v
forall a. (a -> Maybe a) -> Key -> IntMap a -> IntMap a
IL.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) Key
k)
{-# INLINE kvStoreToLazyIntMapState #-}

-- | Interpret a 'KVStore' effect in terms of 'H.HashMap' and strict operations.
kvStoreToHashMapState :: (Hashable k, Eq k) => Eff (KVStore k v ': es) ~> Eff (State (H.HashMap k v) ': es)
kvStoreToHashMapState :: Eff (KVStore k v : es) ~> Eff (State (HashMap k v) : es)
kvStoreToHashMapState = Handler (KVStore k v) '[State (HashMap k v)] es
-> Eff (KVStore k v : es) ~> Eff (State (HashMap k v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (HashMap k v -> Maybe v)
-> Eff (State (HashMap k v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup k
k)
  UpdateKV k v -> (HashMap k v -> HashMap k v) -> Eff (State (HashMap k v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> k -> HashMap k v -> HashMap k v
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
H.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) k
k)
{-# INLINE kvStoreToHashMapState #-}

-- | Interpret a 'KVStore' effect in terms of 'HL.HashMap' and lazy operations.
kvStoreToLazyHashMapState :: (Hashable k, Eq k) => Eff (KVStore k v ': es) ~> Eff (State (HL.HashMap k v) ': es)
kvStoreToLazyHashMapState :: Eff (KVStore k v : es) ~> Eff (State (HashMap k v) : es)
kvStoreToLazyHashMapState = Handler (KVStore k v) '[State (HashMap k v)] es
-> Eff (KVStore k v : es) ~> Eff (State (HashMap k v) : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e '[e'] es -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  LookupKV k   -> (HashMap k v -> Maybe v)
-> Eff (State (HashMap k v) : es) (Maybe v)
forall s (es :: [(Type -> Type) -> Type -> Type]) t.
(State s :> es) =>
(s -> t) -> Eff es t
gets (k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HL.lookup k
k)
  UpdateKV k v -> (HashMap k v -> HashMap k v) -> Eff (State (HashMap k v) : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
(s -> s) -> Eff es ()
modify ((v -> Maybe v) -> k -> HashMap k v -> HashMap k v
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HL.update (Maybe v -> v -> Maybe v
forall a b. a -> b -> a
const Maybe v
v) k
k)
{-# INLINE kvStoreToLazyHashMapState #-}