{-# 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