{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Network.CGI.Monad
-- Copyright   :  (c) Bjorn Bringert 2006
-- License     :  BSD-style
--
-- Maintainer  :  John Chee <cheecheeo@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Internal stuff that most people shouldn't have to use.
-- This module mostly deals with the
-- internals of the CGIT monad transformer.
--
-----------------------------------------------------------------------------

module Network.CGI.Monad (
  -- * CGI monad class
  MonadCGI(..),
  -- * CGI monad transformer
  CGIT(..), CGI,
  runCGIT,
  -- * Request info
  CGIRequest(..),
  -- * Error handling
  throwCGI, catchCGI, tryCGI, handleExceptionCGI,
 ) where

import Prelude hiding ( fail )

import Control.Exception as Exception (SomeException)
import Control.Applicative (Applicative(..))
import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask, throwM, catch, try, mask, uninterruptibleMask, generalBracket)
import Control.Monad.Except (MonadError(..))
import Control.Monad.Reader (ReaderT(..), asks)
import Control.Monad.Writer (WriterT(..), tell)
import Control.Monad.Fail (MonadFail(..))
import Control.Monad.Trans (MonadTrans, MonadIO, liftIO, lift)
import Data.Typeable
import Network.CGI.Protocol


--
-- * CGIT monad transformer
--

-- | A simple CGI monad with just IO.
type CGI a = CGIT IO a

-- | The CGIT monad transformer.
newtype CGIT m a = CGIT { forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT :: ReaderT CGIRequest (WriterT Headers m) a }
                        deriving (Typeable)

instance (Functor m) => Functor (CGIT m) where
    fmap :: forall a b. (a -> b) -> CGIT m a -> CGIT m b
fmap a -> b
f CGIT m a
c = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT CGIT m a
c))

instance (Applicative m) => Applicative (CGIT m) where
    pure :: forall a. a -> CGIT m a
pure = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    CGIT m (a -> b)
f <*> :: forall a b. CGIT m (a -> b) -> CGIT m a -> CGIT m b
<*> CGIT m a
x = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT CGIT m (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT CGIT m a
x)

instance Monad m => Monad (CGIT m) where
    CGIT m a
c >>= :: forall a b. CGIT m a -> (a -> CGIT m b) -> CGIT m b
>>= a -> CGIT m b
f = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT CGIT m a
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CGIT m b
f)
    return :: forall a. a -> CGIT m a
return = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadFail m => MonadFail (CGIT m) where
    fail :: forall a. String -> CGIT m a
fail = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance MonadIO m => MonadIO (CGIT m) where
    liftIO :: forall a. IO a -> CGIT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadThrow m => MonadThrow (CGIT m) where
    throwM :: forall e a. Exception e => e -> CGIT m a
throwM = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (CGIT m) where
    CGIT ReaderT CGIRequest (WriterT Headers m) a
m catch :: forall e a. Exception e => CGIT m a -> (e -> CGIT m a) -> CGIT m a
`catch` e -> CGIT m a
h = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall a b. (a -> b) -> a -> b
$ ReaderT CGIRequest (WriterT Headers m) a
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> CGIT m a
h)

instance MonadMask m => MonadMask (CGIT m) where
    mask :: forall b.
((forall a. CGIT m a -> CGIT m a) -> CGIT m b) -> CGIT m b
mask (forall a. CGIT m a -> CGIT m a) -> CGIT m b
a = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a.
ReaderT CGIRequest (WriterT Headers m) a
-> ReaderT CGIRequest (WriterT Headers m) a
u -> forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT forall a b. (a -> b) -> a -> b
$ (forall a. CGIT m a -> CGIT m a) -> CGIT m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ReaderT CGIRequest (WriterT Headers m) a
-> ReaderT CGIRequest (WriterT Headers m) a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT
    uninterruptibleMask :: forall b.
((forall a. CGIT m a -> CGIT m a) -> CGIT m b) -> CGIT m b
uninterruptibleMask (forall a. CGIT m a -> CGIT m a) -> CGIT m b
a = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a.
ReaderT CGIRequest (WriterT Headers m) a
-> ReaderT CGIRequest (WriterT Headers m) a
u -> forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT forall a b. (a -> b) -> a -> b
$ (forall a. CGIT m a -> CGIT m a) -> CGIT m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ReaderT CGIRequest (WriterT Headers m) a
-> ReaderT CGIRequest (WriterT Headers m) a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT
    generalBracket :: forall a b c.
CGIT m a
-> (a -> ExitCase b -> CGIT m c)
-> (a -> CGIT m b)
-> CGIT m (b, c)
generalBracket CGIT m a
acquire a -> ExitCase b -> CGIT m c
release a -> CGIT m b
f = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT CGIT m a
acquire) (\a
a ExitCase b
b -> forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT (a -> ExitCase b -> CGIT m c
release a
a ExitCase b
b)) (forall (m :: * -> *) a.
CGIT m a -> ReaderT CGIRequest (WriterT Headers m) a
unCGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CGIT m b
f)

instance MonadCatch m => MonadError SomeException (CGIT m) where
    throwError :: forall a. SomeException -> CGIT m a
throwError = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
    catchError :: forall a. CGIT m a -> (SomeException -> CGIT m a) -> CGIT m a
catchError = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | The class of CGI monads. Most CGI actions can be run in
--   any monad which is an instance of this class, which means that
--   you can use your own monad transformers to add extra functionality.
class Monad m => MonadCGI m where
    -- | Add a response header.
    cgiAddHeader :: HeaderName -> String -> m ()
    -- | Get something from the CGI request.
    cgiGet :: (CGIRequest -> a) -> m a

instance Monad m => MonadCGI (CGIT m) where
    cgiAddHeader :: HeaderName -> String -> CGIT m ()
cgiAddHeader HeaderName
n String
v = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(HeaderName
n,String
v)]
    cgiGet :: forall a. (CGIRequest -> a) -> CGIT m a
cgiGet = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks

instance MonadTrans CGIT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> CGIT m a
lift = forall (m :: * -> *) a.
ReaderT CGIRequest (WriterT Headers m) a -> CGIT m a
CGIT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Run a CGI action.
runCGIT :: Monad m => CGIT m a -> CGIRequest -> m (Headers, a)
runCGIT :: forall (m :: * -> *) a.
Monad m =>
CGIT m a -> CGIRequest -> m (Headers, a)
runCGIT (CGIT ReaderT CGIRequest (WriterT Headers m) a
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT CGIRequest (WriterT Headers m) a
c



--
-- * Deprecated error handling functions.
--


{-# DEPRECATED throwCGI "Use Control.Monad.Catch.throwM instead." #-}
-- | Deprecated alias for 'throwM'. Please use 'throwM' instead.
throwCGI :: (MonadThrow m) => SomeException -> m a
throwCGI :: forall (m :: * -> *) a. MonadThrow m => SomeException -> m a
throwCGI = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

{-# DEPRECATED catchCGI "Use Control.Monad.Catch.catch instead." #-}
-- | Deprecated alias for 'catch'. Please use 'catch' instead.
catchCGI :: (MonadCatch m) => m a -> (SomeException -> m a) -> m a
catchCGI :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
catchCGI = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch

{-# DEPRECATED tryCGI "Use Control.Monad.Catch.try instead." #-}
-- | Deprecated alias for 'try'. Please use 'try' instead.
tryCGI :: (MonadCatch m) => m a -> m (Either SomeException a)
tryCGI :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryCGI = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try

{-# DEPRECATED handleExceptionCGI "Use Control.Monad.Catch.catch instead." #-}
-- | Deprecated alias for 'catch'. Please use 'catch' instead.
handleExceptionCGI :: (MonadCatch m) => m a -> (SomeException -> m a) -> m a
handleExceptionCGI :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
handleExceptionCGI = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch