{-# LANGUAGE TemplateHaskell #-}
module Polysemy.KVStore
(
KVStore (..)
, lookupKV
, writeKV
, deleteKV
, updateKV
, runKVStoreAsState
, runKVStorePurely
) where
import qualified Data.Map as M
import Polysemy
import Polysemy.State
data KVStore k v m a where
LookupKV :: k -> KVStore k v m (Maybe v)
UpdateKV :: k -> Maybe v -> KVStore k v m ()
makeSem ''KVStore
writeKV :: Member (KVStore k v) r => k -> v -> Sem r ()
writeKV k = updateKV k . Just
{-# INLINE writeKV #-}
deleteKV :: Member (KVStore k v) r => k -> Sem r ()
deleteKV k = updateKV k Nothing
{-# INLINE deleteKV #-}
runKVStoreAsState :: Ord k => Sem (KVStore k v ': r) a -> Sem (State (M.Map k v) ': r) a
runKVStoreAsState = reinterpret $ \case
LookupKV k -> gets $ M.lookup k
UpdateKV k v -> modify $ M.alter (const v) k
{-# INLINE runKVStoreAsState #-}
runKVStorePurely
:: Ord k
=> M.Map k v
-> Sem (KVStore k v ': r) a
-> Sem r (M.Map k v, a)
runKVStorePurely m = runState m . runKVStoreAsState
{-# INLINE runKVStorePurely #-}