module Network.CGI.Monad (
MonadCGI(..),
CGIT(..), CGI,
runCGIT,
CGIRequest(..),
throwCGI, catchCGI, tryCGI, handleExceptionCGI,
) where
import Prelude hiding (catch)
#if MIN_VERSION_base(4,0,0)
import Control.Exception
#else
import Control.Exception.Extensible
#endif
as Exception (SomeException, throwIO)
import Control.Monad (liftM)
import Control.Monad.Catch (MonadCatch, MonadThrow, throwM, catch, try)
import Control.Monad.Except (MonadError(..))
import Control.Monad.Reader (ReaderT(..), asks)
import Control.Monad.Writer (WriterT(..), tell)
import Control.Monad.Trans (MonadTrans, MonadIO, liftIO, lift)
#if MIN_VERSION_base(4,7,0)
import Data.Typeable
#else
import Data.Typeable (Typeable(..), Typeable1(..),
mkTyConApp, mkTyCon)
#endif
import Network.CGI.Protocol
type CGI a = CGIT IO a
newtype CGIT m a = CGIT { unCGIT :: ReaderT CGIRequest (WriterT Headers m) a }
#if MIN_VERSION_base(4,7,0)
deriving (Typeable)
#else
instance (Typeable1 m, Typeable a) => Typeable (CGIT m a) where
typeOf _ = mkTyConApp (mkTyCon "Network.CGI.Monad.CGIT")
[typeOf1 (undefined :: m a), typeOf (undefined :: a)]
#endif
instance (Functor m, Monad m) => Functor (CGIT m) where
fmap f c = CGIT (fmap f (unCGIT c))
instance Monad m => Monad (CGIT m) where
c >>= f = CGIT (unCGIT c >>= unCGIT . f)
return = CGIT . return
fail = CGIT . fail
instance MonadIO m => MonadIO (CGIT m) where
liftIO = lift . liftIO
instance MonadThrow m => MonadThrow (CGIT m) where
throwM e = CGIT . throwM $ e
instance MonadCatch m => MonadCatch (CGIT m) where
CGIT m `catch` h = CGIT $ m `catch` (unCGIT . h)
class Monad m => MonadCGI m where
cgiAddHeader :: HeaderName -> String -> m ()
cgiGet :: (CGIRequest -> a) -> m a
instance Monad m => MonadCGI (CGIT m) where
cgiAddHeader n v = CGIT $ lift $ tell [(n,v)]
cgiGet = CGIT . asks
instance MonadTrans CGIT where
lift = CGIT . lift . lift
runCGIT :: Monad m => CGIT m a -> CGIRequest -> m (Headers, a)
runCGIT (CGIT c) = liftM (uncurry (flip (,))) . runWriterT . runReaderT c
instance MonadCatch m => MonadError SomeException (CGIT m) where
throwError = throwM
catchError = catch
throwCGI :: (MonadCGI m, MonadThrow m) => SomeException -> m a
throwCGI = throwM
catchCGI :: (MonadCGI m, MonadCatch m) => m a -> (SomeException -> m a) -> m a
catchCGI = catch
tryCGI :: (Functor m, MonadCGI m, MonadCatch m) => m a -> m (Either SomeException a)
tryCGI = try
handleExceptionCGI :: (MonadCGI m, MonadCatch m) => m a -> (SomeException -> m a) -> m a
handleExceptionCGI = catchCGI