Search code examples
haskellmonad-transformerskey-value-store

How to define a simple KVStore effect 'mtl-style'?

I have experimented a little with the polysemy library and enjoyed working with the KVStore k v, which is simple abstraction of a Key-Value-Store. Now I was wondering how I would define a similar effect 'mtl-style'. I am new to the topic and I haven't found a lot of information on how to design applications using monad transformers. I also haven't found any Monad that handles this type of effect, except maybe monad-persistent which seems a little overkill for the simple problem I am trying to solve.

My current approach is to define this typeclass:

class Monad m => KVStore k v m where
  insert :: v -> k -> m ()
  delete :: k -> m ()
  lookup :: k -> m (Maybe v)

Here I am already running into a problem with the delete function, because the type variable v is ambiguous. My IDE is suggesting me to add AllowAmbiguousTypes, but I don't understand the implications of that.

Next I implemented a KVStore instance using StmContainers.Map from stm-containers:

class HasSTMMap k v a where
  stmMapL :: Lens' a (Map k v)

instance (Eq k, Hashable k, HasSTMMap k v r, MonadReader r STM) => KVStore k v STM where
  insert v k = reader (view stmMapL) >>= Map.insert v k
  delete k = reader (view stmMapL) >>= Map.delete k
  lookup k = reader (view stmMapL) >>= Map.lookup k

Again the delete functions is causing problems, because it cannot disambiguate type variable v.

Any help is appreciated, thanks.

Update

Thanks to K. A. Buhr's answer I updated the structure of my project:

class Monad m => MonadKVStore m k v where
  insertKV :: v -> k -> m ()
  deleteKV :: k -> m ()
  lookupKV :: k -> m (Maybe v)

class HasSTMStore k v a where
  stmStoreL :: Lens' a (Map k v)

type AppM env = ReaderT env Handler

instance HasSTMStore k v (Map k v) where
  stmStoreL = id

instance (Eq k, Hashable k, HasSTMStore k v env) => MonadKVStore (AppM env) k v where
  insertKV key value = Reader.asks (Lens.view stmStoreL)
    >>= IO.liftIO . STM.atomically . Map.insert key value

  deleteKV key = do
    (store :: Map k v) <- Reader.asks (Lens.view stmStoreL)
    IO.liftIO $ STM.atomically $ Map.delete key store

  lookupKV key = Reader.asks (Lens.view stmStoreL)
    >>= IO.liftIO . STM.atomically . Map.lookup key

For testing purposes I use a pure Map container like this:

type TestM k v = Reader (Map k v)

instance Ord k => MonadKVStore (TestM k v) k v where
  ...
Solution

  • First off, the class definition:

    class Monad m => KVStore k v m where
  insert :: v -> k -> m ()
  delete :: k -> m ()
  lookup :: k -> m (Maybe v)

    compiles without extensions under modern GHC versions. (I just tested it with GHC 7.10.3, 8.10.7 and 9.0.2.) Is it this code alone that's giving you an ambiguous type error, or is it something else?

    Anyway, this answer explains the AllowAmbiguousTypes extension. In short, there's a check in GHC that prevents you from defining functions that (in most cases) can't ever be called in vanilla Haskell because their types can never be resolved. The AllowAmbiguousTypes extension skips this check. The resulting functions still can't be called in vanilla Haskell, but they often can be called by means of another extension, like TypeApplications.

    So, AllowAmbiguousTypes is harmless, and you should feel free to enable it, with the caveat that you may need to eventually use TypeApplications to apply the functions it allows you to define.

    But, that's not really central to your question about how to go about defining an mtl-style KVStoreT monad transformer. Let me walk you through the process.

    When I'm implementing a monad transformer, I usually start by implementing the non-transformer version. Here, it's worth pointing out that one of the primary differences between polysemy and mtl is that the former allows the same effects to be interpreted in different ways (e.g., runKVStoreAsState versus runKVStorePure), while the latter generally sticks with a fixed implementation. So, in that spirit, you should start with a fixed implementation of a KVStore monad, perhaps using a state-like monad with a Map for its state:

    import Data.Map.Strict (Map)
newtype KVStore k v a = KVStore { runKVStore :: Map k v -> (a, Map k v) }

    Note that this monad closely resembles a non-transformer State monad:

    newtype State s a = State { runState :: s -> (a, s) }

    which you might find in old references about Haskell monads and/or used as the definition of State in a tutorial.

    Now, I feel that taking this example any further will spoil your project, so let me walk you through developing a different example instead -- a CounterT with set and count operations. As I say, I usually start by defining the non-transformer version of the monad:

    {-# LANGUAGE DeriveFunctor #-}

import Control.Monad (ap)

data Counter a
  = Counter { runCounter :: Int -> (a, Int) }
  deriving (Functor)
instance Applicative Counter where
  pure x = Counter (\n -> (x, n))
  (<*>) = ap
instance Monad Counter where
  ma >>= f = Counter $
    \n -> let (b, n') = runCounter ma n in runCounter (f b) n'

    and its operations:

    -- Return current count and increment
count :: Counter Int
count = Counter (\n -> (n, n+1))

-- Set count
set :: Int -> Counter ()
set n = Counter (\_ -> ((), n))

    Here's a quick test:

    foo :: Counter (Int, Int, Int)
foo = do
  x <- count
  y <- count
  set 5
  z <- count
  return (x,y,z)

main = print $ runCounter foo 1

    With the non-transformer implementation running, only now do I convert it to a transformer CounterT:

    data CounterT m a
  = CounterT { runCounterT :: Int -> m (a, Int) }
  deriving (Functor)

    which its associated instances:

    instance Monad m => Applicative (CounterT m) where
  pure x = CounterT (\n -> pure (x, n))
  (<*>) = ap
instance Monad m => Monad (CounterT m) where
  ma >>= f = CounterT $
    \n -> do (b, n') <- runCounterT ma n
             runCounterT (f b) n'

    and operations:

    -- Return current count and increment
count :: Applicative m => CounterT m Int
count = CounterT (\n -> pure (n, n+1))

-- Set count
set :: Applicative m => Int -> CounterT m ()
set n = CounterT (\_ -> pure ((), n))

    This translation from a plain monad to its transformer version can be complicated the first time you work through it. Having the pure reference implementation for the non-transformer version is a big help here.

    Note that this transformer is already partly usable, even though we don't have the appropriate transformer and mtl classes defined:

    foo :: CounterT IO (Int, Int, Int)
foo = do
  x <- count
  y <- count
  set 5
  z <- count
  return (x,y,z)

main = do
  result <- runCounterT foo 1
  print result

    To be able to lift operations (e.g., use an IO operation in a CounterT IO), we need a MonadTrans instance:

    import Control.Monad.Trans

instance MonadTrans CounterT where
  lift act = CounterT (\n -> act >>= \a -> return (a, n))

    and we can also define liftIO via a MonadIO instance, to lift operations all the way through a large stack to a base IO monad, without needing a chain of lifts:

    instance MonadIO m => MonadIO (CounterT m) where
  liftIO = lift . liftIO

    Now we can write examples like:

    foo :: CounterT IO ()
foo = do
  x <- count
  y <- count
  set 5
  z <- count
  liftIO $ print (x,y,z)

main = runCounterT foo 1

    We should also define a plain counter monad that transforms the identity monad (similar to how modern State is defined in terms of StateT) plus its runner:

    import Data.Functor.Identity

type Counter a = CounterT Identity a

runCounter :: Counter a -> Int -> (a, Int)
runCounter act n = runIdentity $ runCounterT act n

    So far, we've built a transformer in the style of the transformers package. What distinguishes mtl transformers is that you don't need to lift named operations, like count and set. To support this, we'll need to move the operations into a class that can apply to any monad stack with a CounterT transformer:

    class Monad m => MonadCounter m where
  count :: m Int
  set :: Int -> m ()

    and define an instance for the CounterT transformer:

    instance Monad m => MonadCounter (CounterT m) where
  count = CounterT (\n -> pure (n, n+1))
  set n = CounterT (\_ -> pure ((), n))

    Now comes the ugly boilerplate. For every other transformer in our ecosystem, we need to define a MonadCounter instance to lift CounterT operations through the transformer. Here are the examples for IdentityT and ReaderT:

    import Control.Monad.Trans.Identity
import Control.Monad.Reader

instance MonadCounter m => MonadCounter (IdentityT m) where
    count = lift count
    set = lift . set
instance MonadCounter m => MonadCounter (ReaderT r m) where
    count = lift count
    set = lift . set

    All the other instances will have basically the same form.

    In addition, for (nearly) every other transformer in our ecosystem, we need to define appropriate instances for CounterT to lift their operations through our transformer. Since IdentityT has no operations, no instance is needed for it, but ReaderT and others will need instances. Here's an example:

    {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import Control.Monad.Reader

-- look for examples in Control.Monad.Reader.Class and copy those
instance MonadReader r m => MonadReader r (CounterT m) where
  ask = lift ask
  local = mapCounterT . local
  reader = lift . reader

-- this was inspired by mapStateT
mapCounterT :: (m (a, Int) -> m (a, Int)) -> CounterT m a -> CounterT m a
mapCounterT f m = CounterT $ f . runCounterT m

    Now we can mix reader and counter operations without explicit lifts, no matter how our monad is stacked:

    bar :: CounterT (ReaderT Int IO) ()
bar = do
    n <- ask
    set n
    n' <- count
    liftIO $ print n'

baz :: ReaderT Int (CounterT IO) ()
baz = do
    n <- ask
    set n
    n' <- count
    liftIO $ print n'

main = do
  runReaderT (runCounterT bar (-999)) 18
  runCounterT (runReaderT baz 18) (-999)

    Here's the full code:

    {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

import Control.Monad (ap)
import Control.Monad.Reader
import Control.Monad.Trans
import Control.Monad.Trans.Identity
import Data.Functor.Identity

data CounterT m a
  = CounterT { runCounterT :: Int -> m (a, Int) }
  deriving (Functor)

instance Monad m => Applicative (CounterT m) where
  pure x = CounterT (\n -> pure (x, n))
  (<*>) = ap
instance Monad m => Monad (CounterT m) where
  ma >>= f = CounterT $
    \n -> do (b, n') <- runCounterT ma n
             runCounterT (f b) n'

type Counter a = CounterT Identity a

runCounter :: Counter a -> Int -> (a, Int)
runCounter act n = runIdentity $ runCounterT act n

class Monad m => MonadCounter m where
  count :: m Int
  set :: Int -> m ()

instance Monad m => MonadCounter (CounterT m) where
  count = CounterT (\n -> pure (n, n+1))
  set n = CounterT (\_ -> pure ((), n))

instance MonadTrans CounterT where
  lift act = CounterT (\n -> act >>= \a -> return (a, n))

instance MonadIO m => MonadIO (CounterT m) where
  liftIO = lift . liftIO

instance MonadCounter m => MonadCounter (IdentityT m) where
    count = lift count
    set = lift . set
instance MonadCounter m => MonadCounter (ReaderT r m) where
    count = lift count
    set = lift . set

-- look for examples in Control.Monad.Reader.Class and copy those
instance MonadReader r m => MonadReader r (CounterT m) where
  ask = lift ask
  local = mapCounterT . local
  reader = lift . reader

-- this was inspired by mapStateT
mapCounterT :: (m (a, Int) -> m (a, Int)) -> CounterT m a -> CounterT m a
mapCounterT f m = CounterT $ f . runCounterT m

foo :: CounterT IO ()
foo = do
  x <- count
  y <- count
  set 5
  z <- count
  liftIO $ print (x,y,z)

bar :: CounterT (ReaderT Int IO) ()
bar = do
    n <- ask
    set n
    n' <- count
    liftIO $ print n'

baz :: ReaderT Int (CounterT IO) ()
baz = do
    n <- ask
    set n
    n' <- count
    liftIO $ print n'

main = do
  runCounterT foo 1
  runReaderT (runCounterT bar (-999)) 18
  runCounterT (runReaderT baz 18) (-999)

    And here's the code for a KVStore which takes almost exactly the same form. Note that for this implementation, I did have to use the AllowAmbiguousTypes extension and found I needed to use TypeApplications to call the delete function. Even insert and lookup needed a fair bit of type hinting to be easily called. I think you would experience the same issues working with the polysemy version of KVStore, though.

    SPOILERS

    .

    .

    SPOILERS

    .

    .

    SPOILERS

    .

    .

    {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import Control.Monad (ap)
import Control.Monad.Reader
import Control.Monad.Trans
import Control.Monad.Trans.Identity
import Data.Functor.Identity
import Prelude hiding (lookup)

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

data KVStoreT k v m a
  = KVStoreT { runKVStoreT :: Map k v -> m (a, Map k v) }
  deriving (Functor)

instance Monad m => Applicative (KVStoreT k v m) where
  pure x = KVStoreT (\kvs -> pure (x, kvs))
  (<*>) = ap
instance Monad m => Monad (KVStoreT k v m) where
  ma >>= f = KVStoreT $
    \kvs -> do (b, kvs') <- runKVStoreT ma kvs
               runKVStoreT (f b) kvs'

type KVStore k v a = KVStoreT k v Identity a

runKVStore :: KVStore k v a -> Map k v -> (a, Map k v)
runKVStore act kvs = runIdentity $ runKVStoreT act kvs

class Monad m => MonadKVStore k v m where
  insert :: k -> v -> m ()
  delete :: k -> m ()
  lookup :: k -> m (Maybe v)

instance (Ord k, Monad m) => MonadKVStore k v (KVStoreT k v m) where
  insert k v = KVStoreT (\kvs -> pure ((), Map.insert k v kvs))
  delete k = KVStoreT (\kvs -> pure ((), Map.delete k kvs))
  lookup k = KVStoreT (\kvs -> pure (Map.lookup k kvs, kvs))

instance MonadTrans (KVStoreT k v) where
  lift act = KVStoreT (\kvs -> act >>= \a -> return (a, kvs))

instance MonadIO m => MonadIO (KVStoreT k v m) where
  liftIO = lift . liftIO

instance MonadKVStore k v m => MonadKVStore k v (IdentityT m) where
    insert k = lift . insert k
    delete = lift . delete @_ @v
    lookup = lift . lookup
instance MonadKVStore k v m => MonadKVStore k v (ReaderT r m) where
    insert k = lift . insert k
    delete = lift . delete @_ @v
    lookup = lift . lookup

-- look for examples in Control.Monad.Reader.Class and copy those
instance MonadReader r m => MonadReader r (KVStoreT k v m) where
  ask = lift ask
  local = mapKVStoreT . local
  reader = lift . reader

mapKVStoreT :: (m (a, Map k v) -> m (a, Map k v)) -> KVStoreT k v m a -> KVStoreT k v m a
mapKVStoreT f m = KVStoreT $ f . runKVStoreT m

foo :: Int -> KVStoreT Int String IO ()
foo k = do
  insert (1 :: Int) "one"
  insert (2 :: Int) "two"
  insert (3 :: Int) "oops"
  delete @_ @String (3 :: Int)
  v <- lookup k
  liftIO $ print (v :: Maybe String)

main = runKVStoreT (foo 2) Map.empty