2

我正在尝试关注这篇博文，以便通过使用免费的 monad 将 Redis 请求的执行与它们的使用区分开来。为了使用 hedis 作为 Redis 客户端，我对提供的代码进行了一些小的更改，这些更改似乎是类型检查。不幸的是，我无法找到或编写满足 runTest 和 runRedis 函数的类型约束的类型类实例，并且当我使用 foo 调用 runTest 时出现以下错误。

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

存储/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

存储/实现.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))

主文件

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

1 回答 1

1

查看 的类型签名：只要是 a runTest，它就会在 monad 中返回一个值。因此，当您调用 runTest 时，您需要将其绑定到这样的 monad 中，但事实并非如此（这就是错误消息告诉您的内容）。尝试（它在它的第一个参数中创建了这样一个单子上下文）。mmMonadState FakeDBIOrunStateT (runTest foo) Map.empty

于 2015-04-06T18:10:13.240 回答