module Network.UrlDisp.Types (UrlS(..), UrlDisp(..)) where
import Control.Applicative (Alternative(..), Applicative(..))
import Control.Monad.Maybe
import Control.Monad.State.Strict
import Network.CGI.Monad
data UrlS = UrlS { pPath :: [String] }
newtype UrlDisp m a = UrlDisp (StateT UrlS (MaybeT m) a)
deriving (Functor, Monad, MonadState UrlS, MonadCGI, MonadIO,
Applicative, Alternative)
instance MonadTrans UrlDisp where
lift m = UrlDisp $ (lift . lift) m
instance MonadCGI m => Applicative (StateT UrlS (MaybeT m)) where
pure = return
(<*>) = ap
instance (MonadCGI m) => Alternative (StateT UrlS (MaybeT m)) where
empty = lift . MaybeT $ return Nothing
a <|> b = StateT $ \s -> MaybeT (runMaybeT (runStateT a s) >>=
\v -> case v of
Nothing -> runMaybeT (runStateT b s)
Just _ -> return v)
instance (MonadCGI m) => MonadCGI (StateT s m) where
cgiAddHeader n v = lift $ cgiAddHeader n v
cgiGet = lift . cgiGet
instance (MonadCGI m) => MonadCGI (MaybeT m) where
cgiAddHeader n v = lift $ cgiAddHeader n v
cgiGet = lift . cgiGet