haskweb/AppMonad.hs

{-# LANGUAGE FlexibleInstances,
             GeneralizedNewtypeDeriving #-}

module AppMonad (
    AppState(..), App, runApp, setHeistState, setNumVisited
) where

import Control.Monad.State
import Control.Monad.Catch

import Network.FastCGI
import Network.CGI.Monad
import Heist

import DatabaseData

data AppState = AppState { heist :: Maybe (HeistState App),
                           numVisited :: Int,
                           connection :: Connection }

setHeistState :: HeistState App -> AppState -> AppState
setHeistState hs as = as { heist = Just hs }

setNumVisited :: Int -> AppState -> AppState
setNumVisited n as = as { numVisited = n }

newtype AppT m a = App { getState :: StateT AppState (CGIT m) a }
                   deriving (Monad, MonadIO, MonadState AppState,
                             Applicative, Functor)

type App = AppT IO

instance MonadCGI (AppT IO) where
    cgiAddHeader n v = App . lift $ cgiAddHeader n v
    cgiGet x = App . lift $ cgiGet x

instance MonadThrow (AppT IO) where
    throwM e = App . lift $ throwM e

instance MonadCatch (AppT IO) where
    {-catch :: AppT IO a -> (e -> AppT IO a) -> AppT IO a-}
    catch (App x) f = App $ catch x (getState . f)

runApp :: AppState -> App CGIResult -> IO ()
runApp as x = do
    let (App handled) = handleErrors x
        y = evalStateT handled as
    runFastCGIorCGI y