Geek Answers Handbook

How to create a Monad stack for a database in Happstack?

I want to create a Happstack application with lots of database access. I think that Monad Stack with IO at the bottom and a notebook with a database record on top (with a journal entry in the middle) will work with clear functions in every access, for 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 about Monad and Monad transformers (I consider this question as an exercise to find out about it), and I have no idea how to start creating a Monad database, how to raise IO from happstack to Database, ... and etc.

+5
source share
2 answers

You probably want to use "ReaderT":

type MyMonad a = ReaderT DbHandle ServerPart a

Reader ask - , , , .

DbHandle - .

"ReaderT" happstack-server, happstack-server .

, , - :

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

(, "" , , ServerPart)

, - ? - :

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

:

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

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

. . runMyMonad, LogHandle, .

, , .

+6

, .

AppConfig ask .

{-# 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"]}
+6

More articles:


All Articles