Question

我正在写一个Happstack服务器，我有一个MongoDB数据库要连接。为此，我创建了一个创建连接池的函数

type MongoPool = Pool IOError Pipe

withMongo :: (MongoPool -> IO a) -> IO ()
withMongo f = do
    pool <- dbPool
    f pool
    killAll pool

然后是一个使用创建的池运行Action的函数：

runDB :: (MonadIO m) => MongoPool -> Action IO a -> m (Either Failure a)
runDB pool f = liftIO $ do
    pipe <- runIOE $ aResource pool
    access pipe master dbName f

很明显，这需要在所有路径中携带pool作为参数。我想将其换成ReaderT，以便runDB可以有类似Action IO a -> ServerPart (Either Failure a)或更好的Action IO a -> ServerPart a类型，其中失败会导致HTTP错误500自动。

我无法理解如何实现这一目标，而且我喜欢那些对Haskell monad和happstack更有经验的人的一些提示。

感谢。

Answer 1

通过这个问题，我找到了另一个非常好的提示，我已经建立了这个。它似乎工作正常，我以为我会分享它：

type MongoPool = Pool IOError Pipe

type DBServerPart a = ReaderT MongoPool (ServerPartT IO) a

hostName = "127.0.0.1"

dbName = "test"

defaultPoolSize = 10

runDB :: Action IO a -> DBServerPart (Either Failure a)
runDB f = do
    pool <- ask
    liftIO $ do
        pipe <- runIOE $ aResource pool
        access pipe master dbName f

withMongo :: DBServerPart a -> ServerPart a
withMongo f = do
    pool <- liftIO $ dbPool
    a <- runReaderT f pool
    liftIO $ killAll pool
    return a

dbPool = newPool fac defaultPoolSize
    where fac = Factory {
            newResource = connect $ host hostName,
            killResource = close,
            isExpired = isClosed
        }

使用Reader扩展ServerPartT Monad

1 个答案: