{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeFamilies, UndecidableInstances  #-}
{-| This module defines the Monad stack used by Happstack. You mostly don't want to be looking in here. Look in "Happstack.Server.Monads" instead.
-}
module Happstack.Server.Internal.Monads where

import Control.Applicative                       (Applicative, pure, (<*>), Alternative(empty,(<|>)))

import Control.Concurrent                        (newMVar)
import Control.Exception                         (throwIO)

import Control.Monad                             ( MonadPlus(mzero, mplus), ap, liftM, msum
                                                 )
import Control.Monad.Base                        ( MonadBase, liftBase )
import Control.Monad.Catch                       ( MonadCatch(..), MonadThrow(..) )
#if !MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.Error                 ( ErrorT, Error, mapErrorT )
#endif
import Control.Monad.Except                      ( MonadError, throwError
                                                 , catchError
                                                 )
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail                        (MonadFail)
import qualified Control.Monad.Fail              as Fail
#endif
import Control.Monad.Reader                      ( ReaderT(ReaderT), runReaderT
                                                 , MonadReader, ask, local, mapReaderT
                                                 )
import qualified Control.Monad.RWS.Lazy as Lazy       ( RWST, mapRWST )
import qualified Control.Monad.RWS.Strict as Strict   ( RWST, mapRWST )

import Control.Monad.Trans.Except                ( ExceptT(ExceptT), mapExceptT, runExceptT )
import Control.Monad.State.Class                      ( MonadState, get, put )
import qualified Control.Monad.State.Lazy as Lazy     ( StateT, mapStateT )
import qualified Control.Monad.State.Strict as Strict ( StateT, mapStateT )
import Control.Monad.Trans                       ( MonadTrans, lift
                                                 , MonadIO, liftIO
                                                 )
import Control.Monad.Trans.Control               ( MonadTransControl(..)
                                                 , MonadBaseControl(..)
                                                 , ComposeSt, defaultLiftBaseWith, defaultRestoreM
                                                 )
import Control.Monad.Writer.Class                ( MonadWriter, tell, pass, listens )
import qualified Control.Monad.Writer.Lazy as Lazy     ( WriterT(WriterT), runWriterT, mapWriterT )
import qualified Control.Monad.Writer.Strict as Strict ( WriterT, mapWriterT )
import qualified Control.Monad.Writer.Class as Writer  ( listen )

import Control.Monad.Trans.Maybe                 (MaybeT(MaybeT), runMaybeT)
import qualified Data.ByteString.Char8           as P
import qualified Data.ByteString.Lazy.UTF8       as LU (fromString)
import Data.Char                                 (ord)
import Data.List                                 (inits, isPrefixOf, stripPrefix, tails)
import Data.Maybe                                (fromMaybe)
import Data.Monoid                               (Monoid(mempty, mappend), Dual(..), Endo(..))
import qualified Data.Semigroup                  as SG
import qualified Paths_happstack_server          as Cabal
import qualified Data.Version                    as DV
import Debug.Trace                               (trace)

import Happstack.Server.Internal.Cookie          (Cookie)
import Happstack.Server.Internal.RFC822Headers   (parseContentType)
import Happstack.Server.Internal.Types           (EscapeHTTP(..), canHaveBody)
import Happstack.Server.Internal.TimeoutIO       (TimeoutIO)
import Happstack.Server.Types
import Prelude                                   (Bool(..), Either(..), Eq(..), Functor(..), IO, Monad(..), Char, Maybe(..), String, Show(..), ($), (.), (>), (++), (&&), (||), (=<<), const, concatMap, flip, id, otherwise, zip)

-- | An alias for 'WebT' when using 'IO'.
type Web a = WebT IO a

-- | An alias for @'ServerPartT' 'IO'@
type ServerPart a = ServerPartT IO a

--------------------------------------
-- HERE BEGINS ServerPartT definitions

-- | 'ServerPartT' is a rich, featureful monad for web development.
--
-- see also: 'simpleHTTP', 'ServerMonad', 'FilterMonad', 'WebMonad', and 'HasRqData'
newtype ServerPartT m a = ServerPartT { forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT :: ReaderT Request (WebT m) a }
#if MIN_VERSION_base(4,9,0)
    deriving (forall a. a -> ServerPartT m a
forall a b. ServerPartT m a -> ServerPartT m b -> ServerPartT m b
forall a b.
ServerPartT m a -> (a -> ServerPartT m b) -> ServerPartT m b
forall {m :: * -> *}. Monad m => Applicative (ServerPartT m)
forall (m :: * -> *) a. Monad m => a -> ServerPartT m a
forall (m :: * -> *) a b.
Monad m =>
ServerPartT m a -> ServerPartT m b -> ServerPartT m b
forall (m :: * -> *) a b.
Monad m =>
ServerPartT m a -> (a -> ServerPartT m b) -> ServerPartT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ServerPartT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ServerPartT m a
>> :: forall a b. ServerPartT m a -> ServerPartT m b -> ServerPartT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ServerPartT m a -> ServerPartT m b -> ServerPartT m b
>>= :: forall a b.
ServerPartT m a -> (a -> ServerPartT m b) -> ServerPartT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ServerPartT m a -> (a -> ServerPartT m b) -> ServerPartT m b
Monad, forall a. String -> ServerPartT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (ServerPartT m)
forall (m :: * -> *) a. MonadFail m => String -> ServerPartT m a
fail :: forall a. String -> ServerPartT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> ServerPartT m a
MonadFail, forall a. ServerPartT m a
forall a. ServerPartT m a -> ServerPartT m a -> ServerPartT m a
forall {m :: * -> *}. MonadPlus m => Monad (ServerPartT m)
forall {m :: * -> *}. MonadPlus m => Alternative (ServerPartT m)
forall (m :: * -> *) a. MonadPlus m => ServerPartT m a
forall (m :: * -> *) a.
MonadPlus m =>
ServerPartT m a -> ServerPartT m a -> ServerPartT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. ServerPartT m a -> ServerPartT m a -> ServerPartT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
ServerPartT m a -> ServerPartT m a -> ServerPartT m a
mzero :: forall a. ServerPartT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => ServerPartT m a
MonadPlus, forall a b. a -> ServerPartT m b -> ServerPartT m a
forall a b. (a -> b) -> ServerPartT m a -> ServerPartT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ServerPartT m b -> ServerPartT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ServerPartT m a -> ServerPartT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ServerPartT m b -> ServerPartT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ServerPartT m b -> ServerPartT m a
fmap :: forall a b. (a -> b) -> ServerPartT m a -> ServerPartT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ServerPartT m a -> ServerPartT m b
Functor)
#else
    deriving (Monad, MonadPlus, Functor)
#endif

instance MonadCatch m => MonadCatch (ServerPartT m) where
    catch :: forall e a.
Exception e =>
ServerPartT m a -> (e -> ServerPartT m a) -> ServerPartT m a
catch ServerPartT m a
action e -> ServerPartT m a
handle = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT ServerPartT m a
action) (forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ServerPartT m a
handle)

instance MonadThrow m => MonadThrow (ServerPartT m) where
    throwM :: forall e a. Exception e => e -> ServerPartT m a
throwM = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadBase b m => MonadBase b (ServerPartT m) where
    liftBase :: forall α. b α -> ServerPartT m α
liftBase = 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 (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance (MonadIO m) => MonadIO (ServerPartT m) where
    liftIO :: forall a. IO a -> ServerPartT m a
liftIO = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    {-# INLINE liftIO #-}

instance MonadTransControl ServerPartT where
    type StT ServerPartT a = StT WebT (StT (ReaderT Request) a)
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ServerPartT -> m a) -> ServerPartT m a
liftWith Run ServerPartT -> m a
f = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (ReaderT Request)
runReader ->
                                 forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run WebT
runWeb ->
                                   Run ServerPartT -> m a
f forall a b. (a -> b) -> a -> b
$ Run WebT
runWeb forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run (ReaderT Request)
runReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT ServerPartT a) -> ServerPartT m a
restoreT = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (ServerPartT m) where
    type StM (ServerPartT m) a = ComposeSt ServerPartT m a
    liftBaseWith :: forall a. (RunInBase (ServerPartT m) b -> b a) -> ServerPartT m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (ServerPartT m) a -> ServerPartT m a
restoreM     = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | Particularly useful when combined with 'runWebT' to produce
-- a @m ('Maybe' 'Response')@ from a 'Request'.
runServerPartT :: ServerPartT m a -> Request -> WebT m a
runServerPartT :: forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT

-- | function for lifting WebT to ServerPartT
--
-- NOTE: This is mostly for internal use. If you want to access the
-- 'Request' in user-code see 'askRq' from 'ServerMonad'.
--
-- > do request <- askRq
-- >    ...
withRequest :: (Request -> WebT m a) -> ServerPartT m a
withRequest :: forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT

-- | A constructor for a 'ServerPartT' when you don't care about the request.
--
-- NOTE: This is mostly for internal use. If you think you need to use
-- it in your own code, you might consider asking on the mailing list
-- or IRC to find out if there is an alternative solution.
anyRequest :: Monad m => WebT m a -> ServerPartT m a
anyRequest :: forall (m :: * -> *) a. Monad m => WebT m a -> ServerPartT m a
anyRequest WebT m a
x = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
_ -> WebT m a
x

-- | Apply a function to transform the inner monad of
-- @'ServerPartT' m@.
--
-- Often used when transforming a monad with 'ServerPartT', since
-- 'simpleHTTP' requires a @'ServerPartT' 'IO' a@.  Refer to 'UnWebT'
-- for an explanation of the structure of the monad.
--
-- Here is an example.  Suppose you want to embed an 'ErrorT' into your
-- 'ServerPartT' to enable 'throwError' and 'catchError' in your 'Monad'.
--
-- > type MyServerPartT e m a = ServerPartT (ErrorT e m) a
--
-- Now suppose you want to pass @MyServerPartT@ into a function that
-- demands a @'ServerPartT' 'IO' a@ (e.g. 'simpleHTTP').  You can
-- provide the function:
--
-- >   unpackErrorT :: (Monad m, Show e) => UnWebT (ErrorT e m) a -> UnWebT m a
-- >   unpackErrorT et = do
-- >      eitherV <- runErrorT et
-- >      return $ case eitherV of
-- >          Left err -> Just (Left $ toResponse $
-- >                                   "Catastrophic failure " ++ show err
-- >                           , filterFun $ \r -> r{rsCode = 500})
-- >          Right x -> x
--
-- With @unpackErrorT@ you can now call 'simpleHTTP'. Just wrap your
-- 'ServerPartT' list.
--
-- >  simpleHTTP nullConf $ mapServerPartT unpackErrorT (myPart `catchError` myHandler)
--
-- Or alternatively:
--
-- >  simpleHTTP' unpackErrorT nullConf (myPart `catchError` myHandler)
--
-- Also see 'Happstack.Server.Error.spUnwrapErrorT' for a more sophisticated version of this
-- function.
--
mapServerPartT :: (     UnWebT m a ->      UnWebT n b)
               -> (ServerPartT m a -> ServerPartT n b)
mapServerPartT :: forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> ServerPartT m a -> ServerPartT n b
mapServerPartT UnWebT m a -> UnWebT n b
f ServerPartT m a
ma = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> WebT m a -> WebT n b
mapWebT UnWebT m a -> UnWebT n b
f (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
ma Request
rq)

-- | A variant of 'mapServerPartT' where the first argument also takes
-- a 'Request'.  Useful if you want to 'runServerPartT' on a different
-- 'ServerPartT' inside your monad (see 'spUnwrapErrorT').
mapServerPartT' :: (Request -> UnWebT m a ->      UnWebT n b)
                -> (      ServerPartT m a -> ServerPartT n b)
mapServerPartT' :: forall (m :: * -> *) a (n :: * -> *) b.
(Request -> UnWebT m a -> UnWebT n b)
-> ServerPartT m a -> ServerPartT n b
mapServerPartT' Request -> UnWebT m a -> UnWebT n b
f ServerPartT m a
ma = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> WebT m a -> WebT n b
mapWebT (Request -> UnWebT m a -> UnWebT n b
f Request
rq) (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
ma Request
rq)

instance MonadTrans (ServerPartT) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> ServerPartT m a
lift m a
m = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest (\Request
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m)

instance (Monad m, MonadPlus m) => SG.Semigroup (ServerPartT m a) where
    <> :: ServerPartT m a -> ServerPartT m a -> ServerPartT m a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (Monad m, MonadPlus m) => Monoid (ServerPartT m a) where
    mempty :: ServerPartT m a
mempty  = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    mappend :: ServerPartT m a -> ServerPartT m a -> ServerPartT m a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)

instance (Monad m, Functor m) => Applicative (ServerPartT m) where
    pure :: forall a. a -> ServerPartT m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b.
ServerPartT m (a -> b) -> ServerPartT m a -> ServerPartT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance (Functor m, MonadPlus m) => Alternative (ServerPartT m) where
    empty :: forall a. ServerPartT m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. ServerPartT m a -> ServerPartT m a -> ServerPartT m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (Monad m, MonadWriter w m) => MonadWriter w (ServerPartT m) where
    tell :: w -> ServerPartT m ()
tell = 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 w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: forall a. ServerPartT m a -> ServerPartT m (a, w)
listen ServerPartT m a
m = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq ->  forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
Writer.listen (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
m Request
rq) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return
    pass :: forall a. ServerPartT m (a, w -> w) -> ServerPartT m a
pass ServerPartT m (a, w -> w)
m = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m (a, w -> w)
m Request
rq) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return

instance (Monad m, MonadError e m) => MonadError e (ServerPartT m) where
    throwError :: forall a. e -> ServerPartT m a
throwError e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e
    catchError :: forall a.
ServerPartT m a -> (e -> ServerPartT m a) -> ServerPartT m a
catchError ServerPartT m a
action e -> ServerPartT m a
handler = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
action Request
rq) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ((forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT forall a b. (a -> b) -> a -> b
$ Request
rq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ServerPartT m a
handler)

instance (Monad m, MonadReader r m) => MonadReader r (ServerPartT m) where
    ask :: ServerPartT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> ServerPartT m a -> ServerPartT m a
local r -> r
fn ServerPartT m a
m = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq-> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
fn (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
m Request
rq)

instance (Monad m, MonadState s m) => MonadState s (ServerPartT m) where
    get :: ServerPartT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> ServerPartT m ()
put = 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 s (m :: * -> *). MonadState s m => s -> m ()
put

instance Monad m => FilterMonad Response (ServerPartT m) where
    setFilter :: (Response -> Response) -> ServerPartT m ()
setFilter = forall (m :: * -> *) a. Monad m => WebT m a -> ServerPartT m a
anyRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter
    composeFilter :: (Response -> Response) -> ServerPartT m ()
composeFilter = forall (m :: * -> *) a. Monad m => WebT m a -> ServerPartT m a
anyRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b.
ServerPartT m b -> ServerPartT m (b, Response -> Response)
getFilter ServerPartT m b
m = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m b
m Request
rq)

instance Monad m => WebMonad Response (ServerPartT m) where
    finishWith :: forall b. Response -> ServerPartT m b
finishWith Response
r = forall (m :: * -> *) a. Monad m => WebT m a -> ServerPartT m a
anyRequest forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith Response
r

-- | The 'ServerMonad' class provides methods for reading or locally
-- modifying the 'Request'. It is essentially a specialized version of
-- the 'MonadReader' class. Providing the unique names, 'askRq' and
-- 'localRq' makes it easier to use 'ServerPartT' and 'ReaderT'
-- together.
class Monad m => ServerMonad m where
    askRq   :: m Request
    localRq :: (Request -> Request) -> m a -> m a

instance (Monad m) => ServerMonad (ServerPartT m) where
    askRq :: ServerPartT m Request
askRq = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *). MonadReader r m => m r
ask
    localRq :: forall a.
(Request -> Request) -> ServerPartT m a -> ServerPartT m a
localRq Request -> Request
f ServerPartT m a
m = forall (m :: * -> *) a.
ReaderT Request (WebT m) a -> ServerPartT m a
ServerPartT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Request -> Request
f (forall (m :: * -> *) a.
ServerPartT m a -> ReaderT Request (WebT m) a
unServerPartT ServerPartT m a
m)

-- | Implementation of 'askRqEnv' for arbitrary 'ServerMonad'.
smAskRqEnv :: (ServerMonad m, MonadIO m) => m ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
smAskRqEnv :: forall (m :: * -> *).
(ServerMonad m, MonadIO m) =>
m ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
smAskRqEnv = do
    Request
rq  <- forall (m :: * -> *). ServerMonad m => m Request
askRq
    Maybe [(String, Input)]
mbi <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if (Method -> Bool
canHaveBody (Request -> Method
rqMethod Request
rq)) Bool -> Bool -> Bool
&& (Maybe ContentType -> Bool
isDecodable (Request -> Maybe ContentType
ctype Request
rq))
      then Request -> IO (Maybe [(String, Input)])
readInputsBody Request
rq
      else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [])
    forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> [(String, Input)]
rqInputsQuery Request
rq, Maybe [(String, Input)]
mbi, Request -> [(String, Cookie)]
rqCookies Request
rq)
    where
        ctype :: Request -> Maybe ContentType
        ctype :: Request -> Maybe ContentType
ctype Request
req = forall (m :: * -> *). MonadFail m => String -> m ContentType
parseContentType forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
P.unpack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r. HasHeaders r => String -> r -> Maybe ByteString
getHeader String
"content-type" Request
req

        isDecodable :: Maybe ContentType -> Bool
        isDecodable :: Maybe ContentType -> Bool
isDecodable Maybe ContentType
Nothing                                                      = Bool
True -- assume it is application/x-www-form-urlencoded
        isDecodable (Just (ContentType String
"application" String
"x-www-form-urlencoded" [(String, String)]
_)) = Bool
True
        isDecodable (Just (ContentType String
"multipart" String
"form-data" [(String, String)]
_ps))             = Bool
True
        isDecodable (Just ContentType
_)                                                     = Bool
False

-- | Implementation of 'localRqEnv' for arbitrary 'ServerMonad'.
smLocalRqEnv :: (ServerMonad m, MonadIO m) => (([(String, Input)], Maybe [(String, Input)], [(String, Cookie)]) -> ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])) -> m b -> m b
smLocalRqEnv :: forall (m :: * -> *) b.
(ServerMonad m, MonadIO m) =>
(([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
 -> ([(String, Input)], Maybe [(String, Input)],
     [(String, Cookie)]))
-> m b -> m b
smLocalRqEnv ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
-> ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
f m b
m = do
    Request
rq <- forall (m :: * -> *). ServerMonad m => m Request
askRq
    Maybe [(String, Input)]
b  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> IO (Maybe [(String, Input)])
readInputsBody Request
rq
    let ([(String, Input)]
q', Maybe [(String, Input)]
b', [(String, Cookie)]
c') = ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
-> ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])
f (Request -> [(String, Input)]
rqInputsQuery Request
rq, Maybe [(String, Input)]
b, Request -> [(String, Cookie)]
rqCookies Request
rq)
    MVar [(String, Input)]
bv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar (forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(String, Input)]
b')
    let rq' :: Request
rq' = Request
rq { rqInputsQuery :: [(String, Input)]
rqInputsQuery = [(String, Input)]
q'
                 , rqInputsBody :: MVar [(String, Input)]
rqInputsBody = MVar [(String, Input)]
bv
                 , rqCookies :: [(String, Cookie)]
rqCookies = [(String, Cookie)]
c'
                 }
    forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq (forall a b. a -> b -> a
const Request
rq') m b
m

-------------------------------
-- HERE BEGINS WebT definitions

-- | A monoid operation container.  If @a@ is a monoid, then
-- 'SetAppend' is a monoid with the following behaviors:
--
-- >  Set    x `mappend` Append y = Set    (x `mappend` y)
-- >  Append x `mappend` Append y = Append (x `mappend` y)
-- >  _        `mappend` Set y    = Set y
--
-- A simple way of summarizing this is, if the right side is 'Append',
-- then the right is appended to the left.  If the right side is
-- 'Set', then the left side is ignored.

data SetAppend a = Set a | Append a
    deriving (SetAppend a -> SetAppend a -> Bool
forall a. Eq a => SetAppend a -> SetAppend a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetAppend a -> SetAppend a -> Bool
$c/= :: forall a. Eq a => SetAppend a -> SetAppend a -> Bool
== :: SetAppend a -> SetAppend a -> Bool
$c== :: forall a. Eq a => SetAppend a -> SetAppend a -> Bool
Eq, Int -> SetAppend a -> ShowS
forall a. Show a => Int -> SetAppend a -> ShowS
forall a. Show a => [SetAppend a] -> ShowS
forall a. Show a => SetAppend a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetAppend a] -> ShowS
$cshowList :: forall a. Show a => [SetAppend a] -> ShowS
show :: SetAppend a -> String
$cshow :: forall a. Show a => SetAppend a -> String
showsPrec :: Int -> SetAppend a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SetAppend a -> ShowS
Show)

instance Monoid a => SG.Semigroup (SetAppend a) where
   Set    a
x <> :: SetAppend a -> SetAppend a -> SetAppend a
<> Append a
y = forall a. a -> SetAppend a
Set    (a
x forall a. Monoid a => a -> a -> a
`mappend` a
y)
   Append a
x <> Append a
y = forall a. a -> SetAppend a
Append (a
x forall a. Monoid a => a -> a -> a
`mappend` a
y)
   SetAppend a
_        <> Set a
y    = forall a. a -> SetAppend a
Set a
y

instance Monoid a => Monoid (SetAppend a) where
   mempty :: SetAppend a
mempty  = forall a. a -> SetAppend a
Append forall a. Monoid a => a
mempty
   mappend :: SetAppend a -> SetAppend a -> SetAppend a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)

-- | Extract the value from a 'SetAppend'.
-- Note that a 'SetAppend' is actually a @CoPointed@ from:
-- <http://hackage.haskell.org/packages/archive/category-extras/latest/doc/html/Control-Functor-Pointed.html>
-- But lets not drag in that dependency. yet...
extract :: SetAppend t -> t
extract :: forall t. SetAppend t -> t
extract (Set    t
x) = t
x
extract (Append t
x) = t
x

instance Functor (SetAppend) where
    fmap :: forall a b. (a -> b) -> SetAppend a -> SetAppend b
fmap a -> b
f (Set    a
x) = forall a. a -> SetAppend a
Set    forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
    fmap a -> b
f (Append a
x) = forall a. a -> SetAppend a
Append forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

-- | 'FilterFun' is a lot more fun to type than @'SetAppend' ('Dual'
-- ('Endo' a))@.
type FilterFun a = SetAppend (Dual (Endo a))

unFilterFun :: FilterFun a -> (a -> a)
unFilterFun :: forall a. FilterFun a -> a -> a
unFilterFun = forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. SetAppend t -> t
extract

-- | turn a function into a 'FilterFun'. Primarily used with 'mapServerPartT'
filterFun :: (a -> a) -> FilterFun a
filterFun :: forall a. (a -> a) -> FilterFun a
filterFun = forall a. a -> SetAppend a
Set forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo

newtype FilterT a m b = FilterT { forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT :: Lazy.WriterT (FilterFun a) m b }
   deriving (forall a b. a -> FilterT a m b -> FilterT a m a
forall a b. (a -> b) -> FilterT a m a -> FilterT a m b
forall a (m :: * -> *) a b.
Functor m =>
a -> FilterT a m b -> FilterT a m a
forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> FilterT a m a -> FilterT a m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FilterT a m b -> FilterT a m a
$c<$ :: forall a (m :: * -> *) a b.
Functor m =>
a -> FilterT a m b -> FilterT a m a
fmap :: forall a b. (a -> b) -> FilterT a m a -> FilterT a m b
$cfmap :: forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> FilterT a m a -> FilterT a m b
Functor, forall a. a -> FilterT a m a
forall a b. FilterT a m a -> FilterT a m b -> FilterT a m a
forall a b. FilterT a m a -> FilterT a m b -> FilterT a m b
forall a b. FilterT a m (a -> b) -> FilterT a m a -> FilterT a m b
forall a b c.
(a -> b -> c) -> FilterT a m a -> FilterT a m b -> FilterT a m c
forall {a} {m :: * -> *}. Applicative m => Functor (FilterT a m)
forall a (m :: * -> *) a. Applicative m => a -> FilterT a m a
forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m a -> FilterT a m b -> FilterT a m a
forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m a -> FilterT a m b -> FilterT a m b
forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m (a -> b) -> FilterT a m a -> FilterT a m b
forall a (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> FilterT a m a -> FilterT a m b -> FilterT a m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. FilterT a m a -> FilterT a m b -> FilterT a m a
$c<* :: forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m a -> FilterT a m b -> FilterT a m a
*> :: forall a b. FilterT a m a -> FilterT a m b -> FilterT a m b
$c*> :: forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m a -> FilterT a m b -> FilterT a m b
liftA2 :: forall a b c.
(a -> b -> c) -> FilterT a m a -> FilterT a m b -> FilterT a m c
$cliftA2 :: forall a (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> FilterT a m a -> FilterT a m b -> FilterT a m c
<*> :: forall a b. FilterT a m (a -> b) -> FilterT a m a -> FilterT a m b
$c<*> :: forall a (m :: * -> *) a b.
Applicative m =>
FilterT a m (a -> b) -> FilterT a m a -> FilterT a m b
pure :: forall a. a -> FilterT a m a
$cpure :: forall a (m :: * -> *) a. Applicative m => a -> FilterT a m a
Applicative, forall a. a -> FilterT a m a
forall a b. FilterT a m a -> FilterT a m b -> FilterT a m b
forall a b. FilterT a m a -> (a -> FilterT a m b) -> FilterT a m b
forall {a} {m :: * -> *}. Monad m => Applicative (FilterT a m)
forall a (m :: * -> *) a. Monad m => a -> FilterT a m a
forall a (m :: * -> *) a b.
Monad m =>
FilterT a m a -> FilterT a m b -> FilterT a m b
forall a (m :: * -> *) a b.
Monad m =>
FilterT a m a -> (a -> FilterT a m b) -> FilterT a m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> FilterT a m a
$creturn :: forall a (m :: * -> *) a. Monad m => a -> FilterT a m a
>> :: forall a b. FilterT a m a -> FilterT a m b -> FilterT a m b
$c>> :: forall a (m :: * -> *) a b.
Monad m =>
FilterT a m a -> FilterT a m b -> FilterT a m b
>>= :: forall a b. FilterT a m a -> (a -> FilterT a m b) -> FilterT a m b
$c>>= :: forall a (m :: * -> *) a b.
Monad m =>
FilterT a m a -> (a -> FilterT a m b) -> FilterT a m b
Monad, forall a (m :: * -> *) a. Monad m => m a -> FilterT a m a
forall (m :: * -> *) a. Monad m => m a -> FilterT a m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> FilterT a m a
$clift :: forall a (m :: * -> *) a. Monad m => m a -> FilterT a m a
MonadTrans)

instance MonadCatch m => MonadCatch (FilterT a m) where
    catch :: forall e a.
Exception e =>
FilterT a m a -> (e -> FilterT a m a) -> FilterT a m a
catch FilterT a m a
action e -> FilterT a m a
handle = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT FilterT a m a
action) (forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FilterT a m a
handle)

instance MonadThrow m => MonadThrow (FilterT a m) where
    throwM :: forall e a. Exception e => e -> FilterT a m a
throwM = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadBase b m => MonadBase b (FilterT a m) where
    liftBase :: forall α. b α -> FilterT a m α
liftBase = 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 (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance (MonadIO m) => MonadIO (FilterT a m) where
    liftIO :: forall a. IO a -> FilterT a m a
liftIO = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    {-# INLINE liftIO #-}

instance MonadTransControl (FilterT a) where
    type StT (FilterT a) b = StT (Lazy.WriterT (FilterFun a)) b
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (FilterT a) -> m a) -> FilterT a m a
liftWith Run (FilterT a) -> m a
f = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (WriterT (FilterFun a))
run -> Run (FilterT a) -> m a
f forall a b. (a -> b) -> a -> b
$ Run (WriterT (FilterFun a))
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (FilterT a) a) -> FilterT a m a
restoreT = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (FilterT a m) where
    type StM (FilterT a m) c = ComposeSt (FilterT a) m c
    liftBaseWith :: forall a. (RunInBase (FilterT a m) b -> b a) -> FilterT a m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (FilterT a m) a -> FilterT a m a
restoreM     = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | A set of functions for manipulating filters.
--
-- 'ServerPartT' implements 'FilterMonad' 'Response' so these methods
-- are the fundamental ways of manipulating 'Response' values.
class Monad m => FilterMonad a m | m->a where
    -- | Ignores all previous alterations to your filter
    --
    -- As an example:
    --
    -- > do
    -- >   composeFilter f
    -- >   setFilter g
    -- >   return "Hello World"
    --
    -- The @'setFilter' g@ will cause the first @'composeFilter' f@ to
    -- be ignored.
    setFilter :: (a->a) -> m ()
    -- | Composes your filter function with the existing filter
    -- function.
    composeFilter :: (a->a) -> m ()
    -- | Retrieves the filter from the environment.
    getFilter :: m b -> m (b, a->a)

-- | Resets all your filters. An alias for @'setFilter' 'id'@.
ignoreFilters :: (FilterMonad a m) => m ()
ignoreFilters :: forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters = forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter forall a. a -> a
id

instance (Monad m) => FilterMonad a (FilterT a m) where
    setFilter :: (a -> a) -> FilterT a m ()
setFilter     = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> SetAppend a
Set    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo
    composeFilter :: (a -> a) -> FilterT a m ()
composeFilter = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> SetAppend a
Append forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo
    getFilter :: forall b. FilterT a m b -> FilterT a m (b, a -> a)
getFilter     = forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) b a.
MonadWriter w m =>
(w -> b) -> m a -> m (a, b)
listens forall a. FilterFun a -> a -> a
unFilterFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT

-- | The basic 'Response' building object.
newtype WebT m a = WebT { forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT :: ExceptT Response (FilterT (Response) (MaybeT m)) a }
    deriving (forall a b. a -> WebT m b -> WebT m a
forall a b. (a -> b) -> WebT m a -> WebT m b
forall (m :: * -> *) a b. Functor m => a -> WebT m b -> WebT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WebT m a -> WebT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WebT m b -> WebT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> WebT m b -> WebT m a
fmap :: forall a b. (a -> b) -> WebT m a -> WebT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WebT m a -> WebT m b
Functor)

instance MonadCatch m => MonadCatch (WebT m) where
    catch :: forall e a. Exception e => WebT m a -> (e -> WebT m a) -> WebT m a
catch WebT m a
action e -> WebT m a
handle = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT WebT m a
action) (forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> WebT m a
handle)

instance MonadThrow m => MonadThrow (WebT m) where
    throwM :: forall e a. Exception e => e -> WebT m a
throwM = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadBase b m => MonadBase b (WebT m) where
    liftBase :: forall α. b α -> WebT m α
liftBase = 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 (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance (MonadIO m) => MonadIO (WebT m) where
    liftIO :: forall a. IO a -> WebT m a
liftIO = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    {-# INLINE liftIO #-}

instance MonadTransControl WebT where
    type StT WebT a = StT MaybeT
                       (StT (FilterT Response)
                        (StT (ExceptT Response) a))
    liftWith :: forall (m :: * -> *) a. Monad m => (Run WebT -> m a) -> WebT m a
liftWith Run WebT -> m a
f = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (ExceptT Response)
runError ->
                          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (FilterT Response)
runFilter ->
                            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run MaybeT
runMaybe ->
                              Run WebT -> m a
f forall a b. (a -> b) -> a -> b
$ Run MaybeT
runMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Run (FilterT Response)
runFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT
    restoreT :: forall (m :: * -> *) a. Monad m => m (StT WebT a) -> WebT m a
restoreT = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (WebT m) where
    type StM (WebT m) a = ComposeSt WebT m a
    liftBaseWith :: forall a. (RunInBase (WebT m) b -> b a) -> WebT m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (WebT m) a -> WebT m a
restoreM     = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- | 'UnWebT' is almost exclusively used with 'mapServerPartT'. If you
-- are not using 'mapServerPartT' then you do not need to wrap your
-- head around this type. If you are -- the type is not as complex as
-- it first appears.
--
-- It is worth discussing the unpacked structure of 'WebT' a bit as
-- it's exposed in 'mapServerPartT' and 'mapWebT'.
--
--  A fully unpacked 'WebT' has a structure that looks like:
--
--  > ununWebT $ WebT m a :: m (Maybe (Either Response a, FilterFun Response))
--
--  So, ignoring @m@, as it is just the containing 'Monad', the
--  outermost layer is a 'Maybe'.  This is 'Nothing' if 'mzero' was
--  called or @'Just' ('Either' 'Response' a, 'SetAppend' ('Endo'
--  'Response'))@ if 'mzero' wasn't called.  Inside the 'Maybe', there
--  is a pair.  The second element of the pair is our filter function
--  @'FilterFun' 'Response'@.  @'FilterFun' 'Response'@ is a type
--  alias for @'SetAppend' ('Dual' ('Endo' 'Response'))@.  This is
--  just a wrapper for a @'Response' -> 'Response'@ function with a
--  particular 'Monoid' behavior.  The value
--
--  >  Append (Dual (Endo f))
--
--  Causes @f@ to be composed with the previous filter.
--
--  >  Set (Dual (Endo f))
--
--  Causes @f@ to not be composed with the previous filter.
--
--  Finally, the first element of the pair is either @'Left'
--  'Response'@ or @'Right' a@.
--
--  Another way of looking at all these pieces is from the behaviors
--  they control.  The 'Maybe' controls the 'mzero' behavior.  @'Set'
--  ('Endo' f)@ comes from the 'setFilter' behavior.  Likewise,
--  @'Append' ('Endo' f)@ is from 'composeFilter'.  @'Left'
--  'Response'@ is what you get when you call 'finishWith' and
--  @'Right' a@ is the normal exit.
--
--  An example case statement looks like:
--
--  >  ex1 webt = do
--  >    val <- ununWebT webt
--  >    case val of
--  >        Nothing -> Nothing  -- this is the interior value when mzero was used
--  >        Just (Left r, f) -> Just (Left r, f) -- r is the value that was passed into "finishWith"
--  >                                             -- f is our filter function
--  >        Just (Right a, f) -> Just (Right a, f) -- a is our normal monadic value
--  >                                               -- f is still our filter function
--
type UnWebT m a = m (Maybe (Either Response a, FilterFun Response))

instance Monad m => Monad (WebT m) where
    WebT m a
m >>= :: forall a b. WebT m a -> (a -> WebT m b) -> WebT m b
>>= a -> WebT m b
f = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT WebT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WebT m b
f
    {-# INLINE (>>=) #-}
    return :: forall a. a -> WebT m a
return a
a = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    {-# INLINE return #-}

#if MIN_VERSION_base(4,9,0)
instance MonadFail m => MonadFail (WebT m) where
#endif

    fail :: forall a. String -> WebT m a
fail String
s = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s)

-- | 'WebMonad' provides a means to end the current computation
-- and return a 'Response' immediately.  This provides an
-- alternate escape route.  In particular it has a monadic value
-- of any type.  And unless you call @'setFilter' 'id'@ first your
-- response filters will be applied normally.
--
-- Extremely useful when you're deep inside a monad and decide
-- that you want to return a completely different content type,
-- since it doesn't force you to convert all your return types to
-- 'Response' early just to accommodate this.
--
-- see also: 'escape' and 'escape''
class Monad m => WebMonad a m | m->a where
    -- abort the current computation and return a value
    finishWith :: a -- ^ value to return (For 'ServerPart', 'a' will always be the type 'Response')
               -> m b

-- | Used to ignore all your filters and immediately end the
-- computation.  A combination of 'ignoreFilters' and 'finishWith'.
escape :: (WebMonad a m, FilterMonad a m) => m a -> m b
escape :: forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape m a
gen = forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
gen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

-- | An alternate form of 'escape' that can be easily used within a do
-- block.
escape' :: (WebMonad a m, FilterMonad a m) => a -> m b
escape' :: forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
a -> m b
escape' a
a = forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith a
a


instance (Monad m) => WebMonad Response (WebT m) where
    finishWith :: forall b. Response -> WebT m b
finishWith Response
r = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Response
r

instance MonadTrans WebT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> WebT m a
lift = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m, MonadPlus m) => MonadPlus (WebT m) where
    -- | Aborts a computation.
    --
    -- This is primarily useful because 'msum' will take an array of
    -- 'MonadPlus' and return the first one that isn't 'mzero', which
    -- is exactly the semantics expected from objects that take lists
    -- of 'ServerPartT'.
    mzero :: forall a. WebT m a
mzero = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a
mzero
    mplus :: forall a. WebT m a -> WebT m a -> WebT m a
mplus WebT m a
x WebT m a
y =  forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall a b. (a -> b) -> a -> b
$ (forall {m :: * -> *} {a}.
WebT m a
-> WriterT
     (SetAppend (Dual (Endo Response))) (MaybeT m) (Either Response a)
lower WebT m a
x) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall {m :: * -> *} {a}.
WebT m a
-> WriterT
     (SetAppend (Dual (Endo Response))) (MaybeT m) (Either Response a)
lower WebT m a
y)
        where lower :: WebT m a
-> WriterT
     (SetAppend (Dual (Endo Response))) (MaybeT m) (Either Response a)
lower = (forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT)

instance (Monad m) => FilterMonad Response (WebT m) where
    setFilter :: (Response -> Response) -> WebT m ()
setFilter Response -> Response
f = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter forall a b. (a -> b) -> a -> b
$ Response -> Response
f
    composeFilter :: (Response -> Response) -> WebT m ()
composeFilter Response -> Response
f = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter forall a b. (a -> b) -> a -> b
$ Response -> Response
f
    getFilter :: forall b. WebT m b -> WebT m (b, Response -> Response)
getFilter     WebT m b
m = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {a} {a} {b}. (Either a a, b) -> Either a (a, b)
lft forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT WebT m b
m)
        where
          lft :: (Either a a, b) -> Either a (a, b)
lft (Left  a
r, b
_) = forall a b. a -> Either a b
Left a
r
          lft (Right a
a, b
f) = forall a b. b -> Either a b
Right (a
a, b
f)

instance (Monad m, MonadPlus m) => SG.Semigroup (WebT m a) where
    <> :: WebT m a -> WebT m a -> WebT m a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (Monad m, MonadPlus m) => Monoid (WebT m a) where
    mempty :: WebT m a
mempty  = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    mappend :: WebT m a -> WebT m a -> WebT m a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)

-- | For when you really need to unpack a 'WebT' entirely (and not
-- just unwrap the first layer with 'unWebT').
ununWebT :: WebT m a -> UnWebT m a
ununWebT :: forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
FilterT a m b -> WriterT (FilterFun a) m b
unFilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
WebT m a -> ExceptT Response (FilterT Response (MaybeT m)) a
unWebT

-- | For wrapping a 'WebT' back up.  @'mkWebT' . 'ununWebT' = 'id'@
mkWebT :: UnWebT m a -> WebT m a
mkWebT :: forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT = forall (m :: * -> *) a.
ExceptT Response (FilterT Response (MaybeT m)) a -> WebT m a
WebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
WriterT (FilterFun a) m b -> FilterT a m b
FilterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT

-- | See 'mapServerPartT' for a discussion of this function.
mapWebT :: (UnWebT m a -> UnWebT n b)
        -> (  WebT m a ->   WebT n b)
mapWebT :: forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> WebT m a -> WebT n b
mapWebT UnWebT m a -> UnWebT n b
f WebT m a
ma = forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT forall a b. (a -> b) -> a -> b
$ UnWebT m a -> UnWebT n b
f (forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT WebT m a
ma)

-- | This is kinda like a very oddly shaped 'mapServerPartT' or 'mapWebT'.
-- You probably want one or the other of those.
localContext :: Monad m => (WebT m a -> WebT m' a) -> ServerPartT m a -> ServerPartT m' a
localContext :: forall (m :: * -> *) a (m' :: * -> *).
Monad m =>
(WebT m a -> WebT m' a) -> ServerPartT m a -> ServerPartT m' a
localContext WebT m a -> WebT m' a
fn ServerPartT m a
hs
    = forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> WebT m a -> WebT m' a
fn (forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
hs Request
rq)

instance (Monad m, Functor m) => Applicative (WebT m) where
    pure :: forall a. a -> WebT m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b. WebT m (a -> b) -> WebT m a -> WebT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance (Functor m, MonadPlus m) => Alternative (WebT m) where
    empty :: forall a. WebT m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. WebT m a -> WebT m a -> WebT m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadReader r m => MonadReader r (WebT m) where
    ask :: WebT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> WebT m a -> WebT m a
local r -> r
fn WebT m a
m = forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
fn (forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT WebT m a
m)

instance MonadState st m => MonadState st (WebT m) where
    get :: WebT m st
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
    put :: st -> WebT m ()
put = 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 s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadError e m => MonadError e (WebT m) where
        throwError :: forall a. e -> WebT m a
throwError e
err = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err
        catchError :: forall a. WebT m a -> (e -> WebT m a) -> WebT m a
catchError WebT m a
action e -> WebT m a
handler = forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT WebT m a
action) (forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> WebT m a
handler)

instance MonadWriter w m => MonadWriter w (WebT m) where
    tell :: w -> WebT m ()
tell = 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 w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: forall a. WebT m a -> WebT m (a, w)
listen WebT m a
m = forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
Writer.listen (forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT WebT m a
m) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {b} {b}.
(Maybe (Either a a, b), b) -> Maybe (Either a (a, b), b)
liftWebT)
        where liftWebT :: (Maybe (Either a a, b), b) -> Maybe (Either a (a, b), b)
liftWebT (Maybe (Either a a, b)
Nothing, b
_) = forall a. Maybe a
Nothing
              liftWebT (Just (Left a
x,b
f), b
_) = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left a
x,b
f)
              liftWebT (Just (Right a
x,b
f),b
w) = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (a
x,b
w),b
f)
    pass :: forall a. WebT m (a, w -> w) -> WebT m a
pass WebT m (a, w -> w)
m = forall (m :: * -> *) a. UnWebT m a -> WebT m a
mkWebT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. WebT m a -> UnWebT m a
ununWebT WebT m (a, w -> w)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {w} {a} {b} {b}.
MonadWriter w m =>
Maybe (Either a (b, w -> w), b) -> m (Maybe (Either a b, b))
liftWebT
        where liftWebT :: Maybe (Either a (b, w -> w), b) -> m (Maybe (Either a b, b))
liftWebT Maybe (Either a (b, w -> w), b)
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              liftWebT (Just (Left a
x,b
f)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left a
x, b
f)
              liftWebT (Just (Right (b, w -> w)
x,b
f)) = forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (forall (m :: * -> *) a. Monad m => a -> m a
return (b, w -> w)
x)forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\b
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right b
a,b
f))

-- | Deprecated: use 'msum'.
multi :: (Monad m, MonadPlus m) => [ServerPartT m a] -> ServerPartT m a
multi :: forall (m :: * -> *) a.
(Monad m, MonadPlus m) =>
[ServerPartT m a] -> ServerPartT m a
multi = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
{-# DEPRECATED multi "Use msum instead" #-}

-- | What is this for, exactly?  I don't understand why @Show a@ is
-- even in the context Deprecated: This function appears to do nothing
-- at all. If it use it, let us know why.
debugFilter :: (MonadIO m, Show a) => ServerPartT m a -> ServerPartT m a
debugFilter :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ServerPartT m a -> ServerPartT m a
debugFilter ServerPartT m a
handle =
    forall (m :: * -> *) a. (Request -> WebT m a) -> ServerPartT m a
withRequest forall a b. (a -> b) -> a -> b
$ \Request
rq -> do
                    a
r <- forall (m :: * -> *) a. ServerPartT m a -> Request -> WebT m a
runServerPartT ServerPartT m a
handle Request
rq
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
{-# DEPRECATED debugFilter "This function appears to do nothing." #-}


-- "Pattern match failure in do expression at src\AppControl.hs:43:24"
-- is converted to:
-- "src\AppControl.hs:43:24: Pattern match failure in do expression"
-- Then we output this to stderr. Help debugging under Emacs console when using GHCi.
-- This is GHC specific, but you may add your favourite compiler here also.
outputTraceMessage :: String -> a -> a
outputTraceMessage :: forall a. String -> a -> a
outputTraceMessage String
s a
c | String
"Pattern match failure " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
    let w :: [(String, String)]
w = [(String
k,String
p) | (String
i,String
p) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
tails String
s) (forall a. [a] -> [[a]]
inits String
s), Just String
k <- [forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
" at " String
i]]
        v :: String
v = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(String
k,String
p) -> String
k forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
p) [(String, String)]
w
    in forall a. String -> a -> a
trace String
v a
c
outputTraceMessage String
s a
c = forall a. String -> a -> a
trace String
s a
c


mkFailMessage :: (FilterMonad Response m, WebMonad Response m) => String -> m b
mkFailMessage :: forall (m :: * -> *) b.
(FilterMonad Response m, WebMonad Response m) =>
String -> m b
mkFailMessage String
s = do
    forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters
    forall a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith (String -> Response
failResponse String
s)

failResponse :: String -> Response
failResponse :: String -> Response
failResponse String
s =
    forall r. HasHeaders r => String -> String -> r -> r
setHeader String
"Content-Type" String
"text/html; charset=UTF-8" forall a b. (a -> b) -> a -> b
$
     Int -> ByteString -> Response
resultBS Int
500 (String -> ByteString
LU.fromString (ShowS
failHtml String
s))

failHtml:: String->String
failHtml :: ShowS
failHtml String
errString =
   String
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
    forall a. [a] -> [a] -> [a]
++ String
"<html><head><title>Happstack "
    forall a. [a] -> [a] -> [a]
++ String
ver forall a. [a] -> [a] -> [a]
++ String
" Internal Server Error</title></head>"
    forall a. [a] -> [a] -> [a]
++ String
"<body><h1>Happstack " forall a. [a] -> [a] -> [a]
++ String
ver forall a. [a] -> [a] -> [a]
++ String
"</h1>"
    forall a. [a] -> [a] -> [a]
++ String
"<p>Something went wrong here<br>"
    forall a. [a] -> [a] -> [a]
++ String
"Internal server error<br>"
    forall a. [a] -> [a] -> [a]
++ String
"Everything has stopped</p>"
    forall a. [a] -> [a] -> [a]
++ String
"<p>The error was \"" forall a. [a] -> [a] -> [a]
++ (ShowS
escapeString String
errString) forall a. [a] -> [a] -> [a]
++ String
"\"</p></body></html>"
    where ver :: String
ver = Version -> String
DV.showVersion Version
Cabal.version

escapeString :: String -> String
escapeString :: ShowS
escapeString String
str = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
encodeEntity String
str
    where
      encodeEntity :: Char -> String
      encodeEntity :: Char -> String
encodeEntity Char
'<' = String
"&lt;"
      encodeEntity Char
'>' = String
"&gt;"
      encodeEntity Char
'&' = String
"&amp;"
      encodeEntity Char
'"' = String
"&quot;"
      encodeEntity Char
c
          | Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
> Int
127 = String
"&#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Char -> Int
ord Char
c) forall a. [a] -> [a] -> [a]
++ String
";"
          | Bool
otherwise = [Char
c]

------------------------------------------------------------------------------
-- ServerMonad, FilterMonad, and WebMonad instances for ReaderT, StateT,
-- WriterT, RWST, and ErrorT
------------------------------------------------------------------------------

-- ReaderT

instance (ServerMonad m) => ServerMonad (ReaderT r m) where
    askRq :: ReaderT r m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> ReaderT r m a -> ReaderT r m a
localRq Request -> Request
f     = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (FilterMonad res m) => FilterMonad res (ReaderT r m) where
    setFilter :: (res -> res) -> ReaderT r m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> ReaderT r m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. ReaderT r m b -> ReaderT r m (b, res -> res)
getFilter     = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter

instance (WebMonad a m) => WebMonad a (ReaderT r m) where
    finishWith :: forall b. a -> ReaderT r m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

-- StateT

instance (ServerMonad m) => ServerMonad (Lazy.StateT s m) where
    askRq :: StateT s m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> StateT s m a -> StateT s m a
localRq Request -> Request
f     = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (ServerMonad m) => ServerMonad (Strict.StateT s m) where
    askRq :: StateT s m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> StateT s m a -> StateT s m a
localRq Request -> Request
f     = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (FilterMonad res m) => FilterMonad res (Lazy.StateT s m) where
    setFilter :: (res -> res) -> StateT s m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> StateT s m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. StateT s m b -> StateT s m (b, res -> res)
getFilter   StateT s m b
m = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT (\m (b, s)
m' ->
                                   do ((b
b,s
s), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, s)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), s
s)) StateT s m b
m

instance (FilterMonad res m) => FilterMonad res (Strict.StateT s m) where
    setFilter :: (res -> res) -> StateT s m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> StateT s m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. StateT s m b -> StateT s m (b, res -> res)
getFilter   StateT s m b
m = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT (\m (b, s)
m' ->
                                   do ((b
b,s
s), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, s)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), s
s)) StateT s m b
m

instance (WebMonad a m) => WebMonad a (Lazy.StateT s m) where
    finishWith :: forall b. a -> StateT s m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

instance (WebMonad a m) => WebMonad a (Strict.StateT s m) where
    finishWith :: forall b. a -> StateT s m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

-- WriterT

instance (ServerMonad m, Monoid w) => ServerMonad (Lazy.WriterT w m) where
    askRq :: WriterT w m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> WriterT w m a -> WriterT w m a
localRq Request -> Request
f     = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (ServerMonad m, Monoid w) => ServerMonad (Strict.WriterT w m) where
    askRq :: WriterT w m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> WriterT w m a -> WriterT w m a
localRq Request -> Request
f     = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (FilterMonad res m, Monoid w) => FilterMonad res (Lazy.WriterT w m) where
    setFilter :: (res -> res) -> WriterT w m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> WriterT w m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. WriterT w m b -> WriterT w m (b, res -> res)
getFilter   WriterT w m b
m = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT (\m (b, w)
m' ->
                                   do ((b
b,w
w), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, w)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), w
w)) WriterT w m b
m

instance (FilterMonad res m, Monoid w) => FilterMonad res (Strict.WriterT w m) where
    setFilter :: (res -> res) -> WriterT w m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> WriterT w m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. WriterT w m b -> WriterT w m (b, res -> res)
getFilter   WriterT w m b
m = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT (\m (b, w)
m' ->
                                   do ((b
b,w
w), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, w)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), w
w)) WriterT w m b
m

instance (WebMonad a m, Monoid w) => WebMonad a (Lazy.WriterT w m) where
    finishWith :: forall b. a -> WriterT w m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

instance (WebMonad a m, Monoid w) => WebMonad a (Strict.WriterT w m) where
    finishWith :: forall b. a -> WriterT w m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

-- RWST

instance (ServerMonad m, Monoid w) => ServerMonad (Lazy.RWST r w s m) where
    askRq :: RWST r w s m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> RWST r w s m a -> RWST r w s m a
localRq Request -> Request
f     = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Lazy.mapRWST (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (ServerMonad m, Monoid w) => ServerMonad (Strict.RWST r w s m) where
    askRq :: RWST r w s m Request
askRq         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> RWST r w s m a -> RWST r w s m a
localRq Request -> Request
f     = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST (forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f)

instance (FilterMonad res m, Monoid w) => FilterMonad res (Lazy.RWST r w s m) where
    setFilter :: (res -> res) -> RWST r w s m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> RWST r w s m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. RWST r w s m b -> RWST r w s m (b, res -> res)
getFilter   RWST r w s m b
m = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Lazy.mapRWST (\m (b, s, w)
m' ->
                                   do ((b
b,s
s,w
w), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, s, w)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), s
s, w
w)) RWST r w s m b
m

instance (FilterMonad res m, Monoid w) => FilterMonad res (Strict.RWST r w s m) where
    setFilter :: (res -> res) -> RWST r w s m ()
setFilter res -> res
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter res -> res
f
    composeFilter :: (res -> res) -> RWST r w s m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. RWST r w s m b -> RWST r w s m (b, res -> res)
getFilter   RWST r w s m b
m = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST (\m (b, s, w)
m' ->
                                   do ((b
b,s
s,w
w), res -> res
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (b, s, w)
m'
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, res -> res
f), s
s, w
w)) RWST r w s m b
m

instance (WebMonad a m, Monoid w) => WebMonad a (Lazy.RWST r w s m) where
    finishWith :: forall b. a -> RWST r w s m b
finishWith     = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

instance (WebMonad a m, Monoid w) => WebMonad a (Strict.RWST r w s m) where
    finishWith :: forall b. a -> RWST r w s m b
finishWith     = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

-- ErrorT

#if !MIN_VERSION_transformers(0,6,0)
instance (Error e, ServerMonad m) => ServerMonad (ErrorT e m) where
    askRq :: ErrorT e m Request
askRq     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> ErrorT e m a -> ErrorT e m a
localRq Request -> Request
f = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f

instance (Error e, FilterMonad a m) => FilterMonad a (ErrorT e m) where
    setFilter :: (a -> a) -> ErrorT e m ()
setFilter a -> a
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter a -> a
f
    composeFilter :: (a -> a) -> ErrorT e m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. ErrorT e m b -> ErrorT e m (b, a -> a)
getFilter ErrorT e m b
m = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT (\m (Either e b)
m' ->
                                 do (Either e b
eb, a -> a
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (Either e b)
m'
                                    case Either e b
eb of
                                      (Left e
e)  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
e)
                                      (Right b
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (b
b, a -> a
f)
                  ) ErrorT e m b
m

instance (Error e, WebMonad a m) => WebMonad a (ErrorT e m) where
    finishWith :: forall b. a -> ErrorT e m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith
#endif

-- ExceptT

instance ServerMonad m => ServerMonad (ExceptT e m) where
    askRq :: ExceptT e m Request
askRq     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
    localRq :: forall a. (Request -> Request) -> ExceptT e m a -> ExceptT e m a
localRq Request -> Request
f = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq Request -> Request
f

instance (FilterMonad a m) => FilterMonad a (ExceptT e m) where
    setFilter :: (a -> a) -> ExceptT e m ()
setFilter a -> a
f   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
setFilter a -> a
f
    composeFilter :: (a -> a) -> ExceptT e m ()
composeFilter = 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 a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter
    getFilter :: forall b. ExceptT e m b -> ExceptT e m (b, a -> a)
getFilter ExceptT e m b
m = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (\m (Either e b)
m' ->
                                 do (Either e b
eb, a -> a
f) <- forall a (m :: * -> *) b. FilterMonad a m => m b -> m (b, a -> a)
getFilter m (Either e b)
m'
                                    case Either e b
eb of
                                      (Left e
e)  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
e)
                                      (Right b
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (b
b, a -> a
f)
                  ) ExceptT e m b
m

instance WebMonad a m => WebMonad a (ExceptT e m) where
    finishWith :: forall b. a -> ExceptT e m b
finishWith    = 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 a (m :: * -> *) b. WebMonad a m => a -> m b
finishWith

escapeHTTP :: (ServerMonad m, MonadIO m) =>
              (TimeoutIO -> IO ())
           -> m a
escapeHTTP :: forall (m :: * -> *) a.
(ServerMonad m, MonadIO m) =>
(TimeoutIO -> IO ()) -> m a
escapeHTTP TimeoutIO -> IO ()
h = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO ((TimeoutIO -> IO ()) -> EscapeHTTP
EscapeHTTP TimeoutIO -> IO ()
h))