    {-# LANGUAGE FlexibleContexts, CPP #-}
    -- | This module provides four classes and some related functions
    -- which provide 'ServerPartT' with much of its web-centric behavior.
    --
    --  1. 'ServerMonad' provides access to the HTTP 'Request'
    --
    --  2. 'FilterMonad' provides the ability to apply filters and transformations to a 'Response'
    --
    --  3. 'WebMonad' provides a way to escape a computation early and return a 'Response'
    --
    --  4. 'HasRqData' which provides access to the decoded QUERY_STRING and request body/form data
    module Happstack.Server.Monads
        ( -- * ServerPartT
          ServerPartT
        , ServerPart
          -- * Happstack class
        , Happstack
          -- * ServerMonad
        , ServerMonad(..)
        , mapServerPartT
        , mapServerPartT'
        , UnWebT
        , filterFun
          -- * FilterMonad
        , FilterMonad(..)
        , ignoreFilters
        , addHeaderM
        , getHeaderM
        , setHeaderM
        , neverExpires
          -- * WebMonad
        , WebMonad(..)
        , escape
        , escape'
          -- * MonadPlus helpers
        , require
        , requireM
        -- * escapeHTTP
        , escapeHTTP
        ) where

    import Control.Applicative               (Alternative, Applicative)
    import Control.Monad                     (MonadPlus(mzero))
    #if !MIN_VERSION_transformers(0,6,0)
    import Control.Monad.Trans.Error         (Error, ErrorT)
    #endif
    import Control.Monad.Trans               (MonadIO(..),MonadTrans(lift))
    import Control.Monad.Trans.Except        (ExceptT)
    import Control.Monad.Reader              (ReaderT)
    import qualified Control.Monad.Writer.Lazy   as Lazy   (WriterT)
    import qualified Control.Monad.Writer.Strict as Strict (WriterT)
    import qualified Control.Monad.State.Lazy    as Lazy   (StateT)
    import qualified Control.Monad.State.Strict  as Strict (StateT)
    import qualified Control.Monad.RWS.Lazy      as Lazy   (RWST)
    import qualified Control.Monad.RWS.Strict    as Strict (RWST)
    import qualified Data.ByteString.Char8       as B
    import Data.Monoid                       (Monoid)
    import Happstack.Server.Internal.Monads
    import Happstack.Server.Types            (Response, addHeader, getHeader, setHeader)
    import Happstack.Server.RqData           (HasRqData)

    -- | A class alias for all the classes a standard server monad (such as 'ServerPartT') is expected to have instances for. This allows you to keep your type signatures shorter and easier to understand.
    class ( ServerMonad m, WebMonad Response m, FilterMonad Response m
          , MonadIO m, MonadPlus m, HasRqData m, Monad m, Functor m
          , Applicative m, Alternative m) => Happstack m

    instance (Functor m, Monad m, MonadPlus m
             , MonadIO m)            => Happstack (ServerPartT m)
    instance (Happstack m)           => Happstack (Lazy.StateT        s m)
    instance (Happstack m)           => Happstack (Strict.StateT      s m)
    instance (Happstack m)           => Happstack (ReaderT        r     m)
    instance (Happstack m, Monoid w) => Happstack (Lazy.WriterT   w     m)
    instance (Happstack m, Monoid w) => Happstack (Strict.WriterT   w   m)
    instance (Happstack m, Monoid w) => Happstack (Lazy.RWST      r w s m)
    instance (Happstack m, Monoid w) => Happstack (Strict.RWST    r w s m)
    #if !MIN_VERSION_transformers(0,6,0)
    instance (Happstack m, Error e)  => Happstack (ErrorT e m)
    #endif
    instance (Happstack m, Monoid e) => Happstack (ExceptT e m)

    -- | Get a header out of the request.
    getHeaderM :: (ServerMonad m) => String -> m (Maybe B.ByteString)
    getHeaderM :: forall (m :: * -> *).
    ServerMonad m =>
    String -> m (Maybe ByteString)
    getHeaderM String
    a = m Request
    forall (m :: * -> *). ServerMonad m => m Request
    askRq m Request
    -> (Request -> m (Maybe ByteString)) -> m (Maybe ByteString)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe ByteString -> m (Maybe ByteString)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> m (Maybe ByteString))
    -> (Request -> Maybe ByteString) -> Request -> m (Maybe ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Request -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    a)

    -- | Add headers into the response.  This method does not overwrite
    -- any existing header of the same name, hence the name 'addHeaderM'.
    -- If you want to replace a header use 'setHeaderM'.
    addHeaderM :: (FilterMonad Response m) => String -> String -> m ()
    addHeaderM :: forall (m :: * -> *).
    FilterMonad Response m =>
    String -> String -> m ()
    addHeaderM String
    a String
    v = (Response -> Response) -> m ()
    forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
    composeFilter ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Response
    res-> String -> String -> Response -> Response
    forall r. HasHeaders r => String -> String -> r -> r
    addHeader String
    a String
    v Response
    res

    -- | Set a header into the response.  This will replace an existing
    -- header of the same name.  Use 'addHeaderM' if you want to add more
    -- than one header of the same name.
    setHeaderM :: (FilterMonad Response m) => String -> String -> m ()
    setHeaderM :: forall (m :: * -> *).
    FilterMonad Response m =>
    String -> String -> m ()
    setHeaderM String
    a String
    v = (Response -> Response) -> m ()
    forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
    composeFilter ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Response
    res -> String -> String -> Response -> Response
    forall r. HasHeaders r => String -> String -> r -> r
    setHeader String
    a String
    v Response
    res

    -- | Set a far-future Expires header.  Useful for static resources.  If the
    -- browser has the resource cached, no extra request is spent.
    neverExpires :: (FilterMonad Response m) => m ()
    neverExpires :: forall (m :: * -> *). FilterMonad Response m => m ()
    neverExpires = String -> String -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    String -> String -> m ()
    setHeaderM String
    "Expires" String
    "Mon, 31 Dec 2035 12:00:00 GMT"

    -- | Run an 'IO' action and, if it returns 'Just', pass it to the
    -- second argument.
    require :: (MonadIO m, MonadPlus m) => IO (Maybe a) -> (a -> m r) -> m r
    require :: forall (m :: * -> *) a r.
    (MonadIO m, MonadPlus m) =>
    IO (Maybe a) -> (a -> m r) -> m r
    require IO (Maybe a)
    fn a -> m r
    handle = do
        mbVal <- IO (Maybe a) -> m (Maybe a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Maybe a)
    fn
        case mbVal of
            Maybe a
    Nothing -> m r
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Just a
    a -> a -> m r
    handle a
    a

    -- | A variant of require that can run in any monad, not just 'IO'.
    requireM :: (MonadTrans t, Monad m, MonadPlus (t m)) => m (Maybe a) -> (a -> t m r) -> t m r
    requireM :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a r.
    (MonadTrans t, Monad m, MonadPlus (t m)) =>
    m (Maybe a) -> (a -> t m r) -> t m r
    requireM m (Maybe a)
    fn a -> t m r
    handle = do
        mbVal <- m (Maybe a) -> t m (Maybe a)
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m (Maybe a)
    fn
        case mbVal of
            Maybe a
    Nothing -> t m r
    forall a. t m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Just a
    a -> a -> t m r
    handle a
    a