使用免费的 monad 来测试 Redis 调用

Question

我正在尝试遵循 this blog post 以通过使用免费的 monad 将 Redis 请求的执行与其使用分开。我对提供的代码做了一些小改动，以便将 hedis 用作 Redis 客户端，这些更改似乎是类型检查。不幸的是，我无法找到或编写满足 runTest 和 runRedis 函数类型约束的类型 class 实例，当我使用 foo.

调用 runTest 时出现以下错误

No instance for (Control.Monad.State.Class.MonadState FakeDB IO)

Storage/Types.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}

module Storage.Types where

import Control.Monad.Free
import Control.Monad.Free.TH

data RedisCmd next = Get' String (Maybe String -> next) |
                     Set' String String next      |
                     Multi' (RedisCmdM ()) next deriving (Functor)

type RedisCmdM = Free RedisCmd

makeFree ''RedisCmd

Storage/Implementations.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Storage.Implementations where

import Control.Monad.State
import Control.Monad.State.Class
import Control.Monad.Free
import Control.Monad.Free.TH
import Data.Functor
import Data.Map (Map)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.Map as M
import qualified Database.Redis as R
import Storage.Types

runDebug :: RedisCmdM a -> IO a
runDebug = iterM run
  where
    run :: RedisCmd (IO a) -> IO a
    run (Get' k f) = do
      putStrLn $ unwords ["GET", k]
      f . Just =<< getLine
    run (Set' k v n) = do
      putStrLn $ unwords ["SET", k, v]
      n
    run (Multi' txn n) = do
      putStrLn "MULTI"
      runDebug txn
      putStrLn "EXEC"
      n

-- newtype FakeDB = FakeDB { insideFDB :: Map String String }
type FakeDB = Map String String

-- instance (MonadIO m) => MonadState R.Connection m where
--   get = lift get
--   put = lift . put

runTest :: MonadState FakeDB m => RedisCmdM a -> m a
runTest = iterM run
  where
    run (Get' k f) = f =<< gets (M.lookup k)
    run (Set' k v n) = do
      modify $ M.insert k v
      n
    run (Multi' txn n) = do
      runTest txn
      n

getC :: R.Connection -> String -> IO (Maybe String)
getC c k = R.runRedis c (getRedis k)

getRedis :: String -> R.Redis (Maybe String)
getRedis k = convert <$> (R.get . C8.pack) k
  where
   convert (Left _)  = Nothing
   convert (Right r) = C8.unpack <$> r

setC :: R.Connection -> String -> String -> IO ()
setC c k v = do
  _ <- R.runRedis c $ R.set (C8.pack k) (C8.pack v)
  return ()

multi :: R.Connection -> (RedisCmdM ()) -> IO ()
multi = undefined

db :: IO R.Connection
db = R.connect R.defaultConnectInfo

runRedis :: (MonadState R.Connection m, MonadIO m) => RedisCmdM a -> m a
runRedis rcmd = withConn $ \c -> (iterM (run c) rcmd)
  where
    run :: R.Connection -> RedisCmd (IO a) -> IO a
    run c (Get' k f) = f =<< getC c k
    run c (Set' k v n) = setC c k v >> n
    run c (Multi' txn n) = undefined --multi c txn >> n
    withConn action = liftIO (join (action <$> db))

Main.hs

{-# LANGUAGE OverloadedStrings #-}

import Storage.Types
import Storage.Implementations (runDebug, runTest, runRedis)

foo :: RedisCmdM ()
foo = do
  mv <- get' "foo"
  case mv of
    Nothing -> return ()
    Just v -> multi' $ do
      set' "foo1" v
      set' "foo2" v

main = do
  runTest foo

Answer 1

查看 runTest 的类型签名：它 returns 是 monad m 中的值，只要 m 是 MonadState FakeDB。因此，当您调用 runTest 时，您需要将其绑定到这样的 monad 中，而 IO 不是（这就是错误消息告诉您的内容）。尝试 runStateT (runTest foo) Map.empty（它在第一个参数中创建了这样一个单子上下文）。

使用免费的 monad 来测试 Redis 调用

Using free monads to test Redis calls

haskell

monad-transformers

state-monad

free-monad