haskell 如何定义一个简单的KVStore效果'mtl风格'？

rt4zxlrg  于 2022-11-14  发布在  其他
关注(0)|答案(1)|浏览(139)

我已经用polysemy库做了一些实验，并且很喜欢使用KVStore k v，它是一个Key-Value-Store的简单抽象。现在我想知道我将如何定义一个类似的效果“mtl-style”。我对这个主题是新的，我还没有找到很多关于如何使用Monad转换器设计应用程序的信息。我也没有找到任何Monad来处理这种类型的效果。除了可能monad-persistent，这似乎有点矫枉过正，为简单的问题，我试图解决。
我目前的方法是定义这个类型类：

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

在这里，我已经遇到了delete函数的问题，因为类型变量v是不明确的。我的IDE建议我添加AllowAmbiguousTypes，但我不明白这意味着什么。
接下来，我使用stm-containers中的StmContainers.Map实现了一个KVStore示例：

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

删除函数同样会引起问题，因为它无法消除类型变量v的歧义。
任何帮助都是感激不尽的，谢谢。

更新

多亏了K. A. Buhr的回答，我更新了我的项目结构：

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

出于测试目的，我使用了一个纯Map容器，如下所示：

type TestM k v = Reader (Map k v)

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

1条答案

按热度按时间
eqqqjvef

eqqqjvef1#

首先，类定义：

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

（我刚刚用GHC 7.10.3、8.10.7和9.0.2测试了它。）是这段代码本身给了你一个不明确的类型错误，还是其他什么原因？
总之，this answer解释了AllowAmbiguousTypes扩展。简而言之，GHC中有一个检查，防止定义（在大多数情况下）不能在vanilla Haskell中调用，因为它们的类型永远不能被解析。AllowAmbiguousTypes扩展跳过了这个检查。结果函数 * 仍然 * 不能在vanilla Haskell中调用，但是它们通常可以通过另一个扩展来调用，比如TypeApplications。
因此，AllowAmbiguousTypes是无害的，您可以随意启用它，但需要注意的是，您最终可能需要使用TypeApplications来应用它允许您定义的函数。
但是，这并不是你关于如何定义mtl风格的KVStoreT monad转换器的问题的核心。
当我实现一个单子转换器时，我通常从实现非转换器版本开始。（例如，runKVStoreAsState与runKVStorePure），而后者通常坚持使用固定的实现。您应该从KVStore单子的固定实现开始，也许可以使用一个类似状态的单子，其状态为Map：

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

请注意，这个单子非常类似于非转换器State单子：

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

您可以在关于Haskell单子的旧参考文献中找到它和/或在tutorial中用作State的定义。
现在，我觉得继续使用这个例子会破坏您的项目，所以让我来指导您开发一个不同的例子--一个带有set和count操作的CounterT。正如我所说，我通常从定义单子的非转换器版本开始：

{-# 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'

和其操作：

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

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

下面是一个快速测试：

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

main = print $ runCounter foo 1

在运行非转换器实现的情况下，我现在才将其转换为转换器CounterT：

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'

和操作：

-- 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))

第一次从一个普通的单子到它的transformer版本的转换是很复杂的，在这里有一个非transformer版本的纯引用实现是一个很大的帮助。
请注意，这个转换器已经部分可用，即使我们没有定义相应的transformer和mtl类：

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

为了能够进行lift操作（例如，在CounterT IO中使用IO操作），我们需要一个MonadTrans示例：

import Control.Monad.Trans

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

我们还可以通过MonadIO示例定义liftIO，以便通过大型堆栈将操作一直提升到基本IO单子，而不需要lift链：

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

现在我们可以写出这样的例子：

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

main = runCounterT foo 1

我们还应该定义一个简单的计数单子，它转换恒等单子（类似于现代的State是如何用StateT定义的）加上它的runner：

import Data.Functor.Identity

type Counter a = CounterT Identity a

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

到目前为止，我们已经构建了一个transformers包风格的转换器。mtl转换器的区别在于，你不需要lift命名操作，比如count和set。为了支持这一点，我们需要将操作移到一个类中，这个类可以应用于任何带有CounterT转换器的单子栈：

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

并为CounterT转换器定义一个示例：

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

现在我们来看看丑陋的样板文件。对于生态系统中的每一个其他转换器，我们需要定义一个MonadCounter示例来提升通过转换器的CounterT操作。下面是IdentityT和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

所有其他示例将具有基本相同的形式。
此外，对于生态系统中的几乎所有其他变压器，我们需要为CounterT定义适当的示例，以通过我们的变压器提升 * 它们 * 的操作。由于IdentityT没有操作，因此不需要示例，但ReaderT和其他变压器需要示例。下面是一个示例：

{-# 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

型
现在，我们可以混合reader和counter操作，而不需要显式提升，不管我们的单子是如何堆叠的：

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)

下面是完整的代码：

{-# 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)

下面是KVStore的代码，它的形式几乎完全相同。请注意，对于此实现，我确实不得不使用AllowAmbiguousTypes扩展，并发现我需要使用TypeApplications来调用delete函数。甚至insert和lookup也需要相当多的类型提示才能轻松调用。不过，我想您在使用多义版本的KVStore时也会遇到同样的问题。

扰流板

。
。

扰流板

。
。

扰流板

。
。

{-# 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

存储器

赞(0）分享  回复(0）举报  2022-11-14
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备13028337号-1 大数据知识库 https://www.saoniuhuo.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com