Extending the ServerPartT Monad with a Reader
-
28-05-2021 - |
Question
I am writing a Happstack server and I have a MongoDB database to connect to. For that, I made a function to create a connection pool
type MongoPool = Pool IOError Pipe
withMongo :: (MongoPool -> IO a) -> IO ()
withMongo f = do
pool <- dbPool
f pool
killAll pool
And then a function to run an Action
with a created pool:
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
It's obvious this requires to carry the pool
in all the routes as a parameter. I would like to wrap it into a ReaderT
, so that runDB
can have a type like Action IO a -> ServerPart (Either Failure a)
or even better, Action IO a -> ServerPart a
in which a failure will result in an HTTP Error 500 automatically.
I have a trouble wrapping my head around how that can be achieved and I'd love for some hints from people who've more experience with Haskell monads and happstack.
Thanks.
Solution
Through this question I found another with a very good hint, and I have built this. It seems to work fine and I thought I'd share it:
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
}