3

我正在编写一个 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 monads 和 happstack 有更多经验的人那里得到一些提示。

谢谢。

4

1 回答 1

3

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

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
        }
于 2012-04-01T13:01:22.033 回答