module HSP.Monad (
HSP, HSPT, HSPT',
runHSP, evalHSP, runHSPT, evalHSPT, getEnv,
unsafeRunHSP,
getParam, getIncNumber, doIO, catch,
setMetaData, withMetaData
) where
import Control.Monad.RWS (RWST(..), ask, lift, put)
import Control.Monad.State
import Control.Monad.Trans (MonadIO(..))
import Prelude hiding (catch)
import Control.Exception (catchDyn)
import HSP.Exception
import HSP.Env
import HSP.XML
import HSX.XMLGenerator (XMLGenT(..), unXMLGenT)
type HSP = HSPT IO
type HSPT' m = RWST HSPEnv () (Maybe XMLMetaData) m
type HSPT m = XMLGenT (HSPT' m)
dummyEnv :: HSPEnv
dummyEnv = undefined
runHSP :: Maybe XMLMetaData -> HSP a -> HSPEnv -> IO (Maybe XMLMetaData, a)
runHSP xmd hsp hspEnv = runRWST (unXMLGenT hsp) hspEnv xmd >>= \(a,md,()) -> return (md, a)
runHSPT :: (Monad m) => Maybe XMLMetaData -> HSPT m a -> HSPEnv -> m (Maybe XMLMetaData, a)
runHSPT xmd hsp hspEnv = runRWST (unXMLGenT hsp) hspEnv xmd >>= \(a,md,()) -> return (md, a)
evalHSPT :: MonadIO m => Maybe XMLMetaData -> HSPT m a -> m (Maybe XMLMetaData, a)
evalHSPT xmd hsp = liftIO mkSimpleEnv >>= \env -> runHSPT xmd hsp env
evalHSP :: Maybe XMLMetaData -> HSP a -> IO (Maybe XMLMetaData, a)
evalHSP xmd hsp = mkSimpleEnv >>= \env -> runHSP xmd hsp env
unsafeRunHSP :: HSP a -> IO (Maybe XMLMetaData, a)
unsafeRunHSP hspf = runHSP Nothing hspf dummyEnv
doIO :: IO a -> HSP a
doIO = liftIO
setMetaData :: (Monad m) => (Maybe XMLMetaData) -> HSPT m ()
setMetaData xmd = lift (put xmd)
withMetaData :: (Monad m) => Maybe XMLMetaData -> HSPT m a -> HSPT m a
withMetaData xmd h = do
x <- h
setMetaData xmd
return x
getEnv :: HSP HSPEnv
getEnv = lift ask
getRequest :: HSP Request
getRequest = fmap getReq getEnv
getParam :: String -> HSP (Maybe String)
getParam s = getRequest >>= \req -> return $ getParameter req s
getIncNumber :: HSP Int
getIncNumber = getEnv >>= doIO . incNumber . getNG
catch :: HSP a -> (Exception -> HSP a) -> HSP a
catch (XMLGenT (RWST f)) handler = XMLGenT $ RWST $ \e s ->
f e s `catchDyn` (\ex -> (let (XMLGenT (RWST g)) = handler ex
in g e s))