使用读卡器扩展ServerPartT Monad

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
        }