{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
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)

-- FIXME: orphan instances, but apparently
-- there's no other way...
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