Расширение монады ServerPartT с помощью ридера - PullRequest
Новая
       25

Расширение монады ServerPartT с помощью ридера

3 голосов
/ 01 апреля 2012

Я пишу сервер 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 и happystack.

Спасибо.

1 Ответ

3 голосов
/ 01 апреля 2012

Благодаря этому вопросу я нашел другой с очень хорошим намеком, и я построил это.Кажется, он работает нормально, и я решил поделиться им: 

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
        }
...