How to create a Database Monad Stack in Happstack?

Question

I want to create a Happstack application with lots of access to a database. I think that a Monad Stack with IO at the bottom and a Database Write-like monad on top (with log writer in the middle) will work to have a clear functions in each access, example:

itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
  methodM [GET,HEAD]
  liftIO $ noticeM (scLogger cf) "sended job list"

  items <- runDBMonad (scDBConnString cf) $ getItemLists

  case items of
    (Right xs) -> ok $ toResponse $ show xs
    (Left err) -> internalServerError $ toResponse $ show err

With:

getItemList :: MyDBMonad (Error [Item])
getItemList = do
  -- etc...

But I have little knowledge of Monad and Monad Transformers (I see this question as an exercise to learn about it), and I have no idea how to begin the creation of Database Monad, how to lift the IO from happstack to the Database Stack,...etc.

Answer 1

You likely want to use 'ReaderT':

type MyMonad a = ReaderT DbHandle ServerPart a

The Reader monad transformer makes a single value accessible using the ask function - in this case, the value we want everyone to get at is the database connection.

Here, DbHandle is some connection to your database.

Because 'ReaderT' is already an instance of all of the happstack-server type-classes all normal happstack-server functions will work in this monad.

You probably also want some sort of helper to open and close the database connection:

runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
   db <- liftIO $ connect_to_your_db connectionString
   result <- runReaderT m db
   liftIO $ close_your_db_connection db

(It might be better to use a function like 'bracket' here, but I don't know that there is such an operation for the ServerPart monad)

I don't know how you want to do logging - how do you plan to interact with your log-file? Something like:

type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a

and then:

askDb :: MyMonad DbHandle
askDb = fst <$> ask

askLogger :: MyMonad LogHandle
askLogger = snd <$> ask

might be enough. You could then build on those primitives to make higher-level functions. You would also need to change runMyMonad to be passed in a LogHandle, whatever that is.

Once you get more than two things you want access to it pays to have a proper record type instead of a tuple.

Answer 2

Here is some minimal working code compiled from snippets above for confused newbies like me.

You put stuff into AppConfig type and grab it with ask inside your response makers.

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C

myApp :: AppMonad Response
myApp = do
    -- access app config. look mom, no lift!
    test <- ask

    -- try some happstack funs. no lift either.
    rq <- askRq
    bs <- lookBS "lol"

    -- test IO please ignore
    liftIO . print $ test
    liftIO . print $ rq
    liftIO . print $ bs

    -- bye
    ok $ toResponse ("Oh, hi!" :: C.ByteString)

-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
                           , appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []

type AppMonad = ReaderT AppConfig (ServerPartT IO)

main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}