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)
data KVStore k v :: Effect where
LookupKV :: k -> KVStore k v m (Maybe v)
UpdateKV :: k -> Maybe v -> KVStore k v m ()
makeEffect ''KVStore
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
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
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
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
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
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
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}