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)
#ifdef BASE4
import Control.OldException (catchDyn)
#else
import Control.Exception (catchDyn)
#endif
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))