{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Web.Scotty.Internal.Types where

import           Blaze.ByteString.Builder (Builder)

import           Control.Applicative
import qualified Control.Exception as E
import           Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)
import           Control.Monad.Catch (MonadCatch, catch, MonadThrow, throwM)
import           Control.Monad.Error.Class
import qualified Control.Monad.Fail as Fail
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT)
import           Control.Monad.Trans.Except

import qualified Data.ByteString as BS
import           Data.ByteString.Lazy.Char8 (ByteString)
import           Data.Default.Class (Default, def)
#if !(MIN_VERSION_base(4,8,0))
import           Data.Monoid (mempty)
#endif
import           Data.String (IsString(..))
import           Data.Text.Lazy (Text, pack)
import           Data.Typeable (Typeable)

import           Network.HTTP.Types

import           Network.Wai hiding (Middleware, Application)
import qualified Network.Wai as Wai
import           Network.Wai.Handler.Warp (Settings, defaultSettings)
import           Network.Wai.Parse (FileInfo)

--------------------- Options -----------------------
data Options = Options { Options -> Int
verbose :: Int -- ^ 0 = silent, 1(def) = startup banner
                       , Options -> Settings
settings :: Settings -- ^ Warp 'Settings'
                                              -- Note: to work around an issue in warp,
                                              -- the default FD cache duration is set to 0
                                              -- so changes to static files are always picked
                                              -- up. This likely has performance implications,
                                              -- so you may want to modify this for production
                                              -- servers using `setFdCacheDuration`.
                       }

instance Default Options where
    def :: Options
def = Int -> Settings -> Options
Options 1 Settings
defaultSettings

----- Transformer Aware Applications/Middleware -----
type Middleware m = Application m -> Application m
type Application m = Request -> m Response

--------------- Scotty Applications -----------------
data ScottyState e m =
    ScottyState { ScottyState e m -> [Middleware]
middlewares :: [Wai.Middleware]
                , ScottyState e m -> [Middleware m]
routes :: [Middleware m]
                , ScottyState e m -> ErrorHandler e m
handler :: ErrorHandler e m
                }

instance Default (ScottyState e m) where
    def :: ScottyState e m
def = [Middleware]
-> [Middleware m] -> ErrorHandler e m -> ScottyState e m
forall e (m :: * -> *).
[Middleware]
-> [Middleware m] -> ErrorHandler e m -> ScottyState e m
ScottyState [] [] ErrorHandler e m
forall a. Maybe a
Nothing

addMiddleware :: Wai.Middleware -> ScottyState e m -> ScottyState e m
addMiddleware :: Middleware -> ScottyState e m -> ScottyState e m
addMiddleware m :: Middleware
m s :: ScottyState e m
s@(ScottyState {middlewares :: forall e (m :: * -> *). ScottyState e m -> [Middleware]
middlewares = [Middleware]
ms}) = ScottyState e m
s { middlewares :: [Middleware]
middlewares = Middleware
mMiddleware -> [Middleware] -> [Middleware]
forall a. a -> [a] -> [a]
:[Middleware]
ms }

addRoute :: Middleware m -> ScottyState e m -> ScottyState e m
addRoute :: Middleware m -> ScottyState e m -> ScottyState e m
addRoute r :: Middleware m
r s :: ScottyState e m
s@(ScottyState {routes :: forall e (m :: * -> *). ScottyState e m -> [Middleware m]
routes = [Middleware m]
rs}) = ScottyState e m
s { routes :: [Middleware m]
routes = Middleware m
rMiddleware m -> [Middleware m] -> [Middleware m]
forall a. a -> [a] -> [a]
:[Middleware m]
rs }

addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m
addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m
addHandler h :: ErrorHandler e m
h s :: ScottyState e m
s = ScottyState e m
s { handler :: ErrorHandler e m
handler = ErrorHandler e m
h }

newtype ScottyT e m a = ScottyT { ScottyT e m a -> State (ScottyState e m) a
runS :: State (ScottyState e m) a }
    deriving ( a -> ScottyT e m b -> ScottyT e m a
(a -> b) -> ScottyT e m a -> ScottyT e m b
(forall a b. (a -> b) -> ScottyT e m a -> ScottyT e m b)
-> (forall a b. a -> ScottyT e m b -> ScottyT e m a)
-> Functor (ScottyT e m)
forall a b. a -> ScottyT e m b -> ScottyT e m a
forall a b. (a -> b) -> ScottyT e m a -> ScottyT e m b
forall e (m :: * -> *) a b. a -> ScottyT e m b -> ScottyT e m a
forall e (m :: * -> *) a b.
(a -> b) -> ScottyT e m a -> ScottyT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ScottyT e m b -> ScottyT e m a
$c<$ :: forall e (m :: * -> *) a b. a -> ScottyT e m b -> ScottyT e m a
fmap :: (a -> b) -> ScottyT e m a -> ScottyT e m b
$cfmap :: forall e (m :: * -> *) a b.
(a -> b) -> ScottyT e m a -> ScottyT e m b
Functor, Functor (ScottyT e m)
a -> ScottyT e m a
Functor (ScottyT e m) =>
(forall a. a -> ScottyT e m a)
-> (forall a b.
    ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b)
-> (forall a b c.
    (a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e m c)
-> (forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m b)
-> (forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m a)
-> Applicative (ScottyT e m)
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
ScottyT e m a -> ScottyT e m b -> ScottyT e m a
ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b
(a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e m c
forall a. a -> ScottyT e m a
forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m a
forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m b
forall a b. ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b
forall a b c.
(a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e m c
forall e (m :: * -> *). Functor (ScottyT e m)
forall e (m :: * -> *) a. a -> ScottyT e m a
forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m a
forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
forall e (m :: * -> *) a b.
ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b
forall e (m :: * -> *) a b c.
(a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e 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
<* :: ScottyT e m a -> ScottyT e m b -> ScottyT e m a
$c<* :: forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m a
*> :: ScottyT e m a -> ScottyT e m b -> ScottyT e m b
$c*> :: forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
liftA2 :: (a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
(a -> b -> c) -> ScottyT e m a -> ScottyT e m b -> ScottyT e m c
<*> :: ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b
$c<*> :: forall e (m :: * -> *) a b.
ScottyT e m (a -> b) -> ScottyT e m a -> ScottyT e m b
pure :: a -> ScottyT e m a
$cpure :: forall e (m :: * -> *) a. a -> ScottyT e m a
$cp1Applicative :: forall e (m :: * -> *). Functor (ScottyT e m)
Applicative, Applicative (ScottyT e m)
a -> ScottyT e m a
Applicative (ScottyT e m) =>
(forall a b.
 ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e m b)
-> (forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m b)
-> (forall a. a -> ScottyT e m a)
-> Monad (ScottyT e m)
ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e m b
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
forall a. a -> ScottyT e m a
forall a b. ScottyT e m a -> ScottyT e m b -> ScottyT e m b
forall a b. ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e m b
forall e (m :: * -> *). Applicative (ScottyT e m)
forall e (m :: * -> *) a. a -> ScottyT e m a
forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
forall e (m :: * -> *) a b.
ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e 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 :: a -> ScottyT e m a
$creturn :: forall e (m :: * -> *) a. a -> ScottyT e m a
>> :: ScottyT e m a -> ScottyT e m b -> ScottyT e m b
$c>> :: forall e (m :: * -> *) a b.
ScottyT e m a -> ScottyT e m b -> ScottyT e m b
>>= :: ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e m b
$c>>= :: forall e (m :: * -> *) a b.
ScottyT e m a -> (a -> ScottyT e m b) -> ScottyT e m b
$cp1Monad :: forall e (m :: * -> *). Applicative (ScottyT e m)
Monad )


------------------ Scotty Errors --------------------
data ActionError e = Redirect Text
                   | Next
                   | Finish
                   | ActionError e

-- | In order to use a custom exception type (aside from 'Text'), you must
-- define an instance of 'ScottyError' for that type.
class ScottyError e where
    stringError :: String -> e
    showError :: e -> Text

instance ScottyError Text where
    stringError :: String -> Text
stringError = String -> Text
pack
    showError :: Text -> Text
showError = Text -> Text
forall a. a -> a
id

instance ScottyError e => ScottyError (ActionError e) where
    stringError :: String -> ActionError e
stringError = e -> ActionError e
forall e. e -> ActionError e
ActionError (e -> ActionError e) -> (String -> e) -> String -> ActionError e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> e
forall e. ScottyError e => String -> e
stringError
    showError :: ActionError e -> Text
showError (Redirect url :: Text
url)  = Text
url
    showError Next            = String -> Text
pack "Next"
    showError Finish          = String -> Text
pack "Finish"
    showError (ActionError e :: e
e) = e -> Text
forall e. ScottyError e => e -> Text
showError e
e

type ErrorHandler e m = Maybe (e -> ActionT e m ())

------------------ Scotty Actions -------------------
type Param = (Text, Text)

type File = (Text, FileInfo ByteString)

data ActionEnv = Env { ActionEnv -> Request
getReq       :: Request
                     , ActionEnv -> [Param]
getParams    :: [Param]
                     , ActionEnv -> IO ByteString
getBody      :: IO ByteString
                     , ActionEnv -> IO ByteString
getBodyChunk :: IO BS.ByteString
                     , ActionEnv -> [File]
getFiles     :: [File]
                     }

data RequestBodyState = BodyUntouched
                      | BodyCached ByteString [BS.ByteString] -- whole body, chunks left to stream
                      | BodyCorrupted

data BodyPartiallyStreamed = BodyPartiallyStreamed deriving (Int -> BodyPartiallyStreamed -> ShowS
[BodyPartiallyStreamed] -> ShowS
BodyPartiallyStreamed -> String
(Int -> BodyPartiallyStreamed -> ShowS)
-> (BodyPartiallyStreamed -> String)
-> ([BodyPartiallyStreamed] -> ShowS)
-> Show BodyPartiallyStreamed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyPartiallyStreamed] -> ShowS
$cshowList :: [BodyPartiallyStreamed] -> ShowS
show :: BodyPartiallyStreamed -> String
$cshow :: BodyPartiallyStreamed -> String
showsPrec :: Int -> BodyPartiallyStreamed -> ShowS
$cshowsPrec :: Int -> BodyPartiallyStreamed -> ShowS
Show, Typeable)

instance E.Exception BodyPartiallyStreamed

data Content = ContentBuilder Builder
             | ContentFile    FilePath
             | ContentStream  StreamingBody

data ScottyResponse = SR { ScottyResponse -> Status
srStatus  :: Status
                         , ScottyResponse -> ResponseHeaders
srHeaders :: ResponseHeaders
                         , ScottyResponse -> Content
srContent :: Content
                         }

instance Default ScottyResponse where
    def :: ScottyResponse
def = Status -> ResponseHeaders -> Content -> ScottyResponse
SR Status
status200 [] (Builder -> Content
ContentBuilder Builder
forall a. Monoid a => a
mempty)

newtype ActionT e m a = ActionT { ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
    deriving ( a -> ActionT e m b -> ActionT e m a
(a -> b) -> ActionT e m a -> ActionT e m b
(forall a b. (a -> b) -> ActionT e m a -> ActionT e m b)
-> (forall a b. a -> ActionT e m b -> ActionT e m a)
-> Functor (ActionT e m)
forall a b. a -> ActionT e m b -> ActionT e m a
forall a b. (a -> b) -> ActionT e m a -> ActionT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ActionT e m b -> ActionT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ActionT e m a -> ActionT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ActionT e m b -> ActionT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ActionT e m b -> ActionT e m a
fmap :: (a -> b) -> ActionT e m a -> ActionT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ActionT e m a -> ActionT e m b
Functor, Functor (ActionT e m)
a -> ActionT e m a
Functor (ActionT e m) =>
(forall a. a -> ActionT e m a)
-> (forall a b.
    ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b)
-> (forall a b c.
    (a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e m c)
-> (forall a b. ActionT e m a -> ActionT e m b -> ActionT e m b)
-> (forall a b. ActionT e m a -> ActionT e m b -> ActionT e m a)
-> Applicative (ActionT e m)
ActionT e m a -> ActionT e m b -> ActionT e m b
ActionT e m a -> ActionT e m b -> ActionT e m a
ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b
(a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e m c
forall a. a -> ActionT e m a
forall a b. ActionT e m a -> ActionT e m b -> ActionT e m a
forall a b. ActionT e m a -> ActionT e m b -> ActionT e m b
forall a b. ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b
forall a b c.
(a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e m c
forall e (m :: * -> *). Monad m => Functor (ActionT e m)
forall e (m :: * -> *) a. Monad m => a -> ActionT e m a
forall e (m :: * -> *) a b.
Monad m =>
ActionT e m a -> ActionT e m b -> ActionT e m a
forall e (m :: * -> *) a b.
Monad m =>
ActionT e m a -> ActionT e m b -> ActionT e m b
forall e (m :: * -> *) a b.
Monad m =>
ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e 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
<* :: ActionT e m a -> ActionT e m b -> ActionT e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
ActionT e m a -> ActionT e m b -> ActionT e m a
*> :: ActionT e m a -> ActionT e m b -> ActionT e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
ActionT e m a -> ActionT e m b -> ActionT e m b
liftA2 :: (a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ActionT e m a -> ActionT e m b -> ActionT e m c
<*> :: ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
ActionT e m (a -> b) -> ActionT e m a -> ActionT e m b
pure :: a -> ActionT e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> ActionT e m a
$cp1Applicative :: forall e (m :: * -> *). Monad m => Functor (ActionT e m)
Applicative, Monad (ActionT e m)
Monad (ActionT e m) =>
(forall a. IO a -> ActionT e m a) -> MonadIO (ActionT e m)
IO a -> ActionT e m a
forall a. IO a -> ActionT e m a
forall e (m :: * -> *).
(MonadIO m, ScottyError e) =>
Monad (ActionT e m)
forall e (m :: * -> *) a.
(MonadIO m, ScottyError e) =>
IO a -> ActionT e m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ActionT e m a
$cliftIO :: forall e (m :: * -> *) a.
(MonadIO m, ScottyError e) =>
IO a -> ActionT e m a
$cp1MonadIO :: forall e (m :: * -> *).
(MonadIO m, ScottyError e) =>
Monad (ActionT e m)
MonadIO )

instance (Monad m, ScottyError e) => Monad (ActionT e m) where
    return :: a -> ActionT e m a
return = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (a
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> a
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ActionT m :: ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m >>= :: ActionT e m a -> (a -> ActionT e m b) -> ActionT e m b
>>= k :: a -> ActionT e m b
k = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b
-> ActionT e m b
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> (a
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT e m b
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM (ActionT e m b
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b)
-> (a -> ActionT e m b)
-> a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ActionT e m b
k)
#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
#endif

instance (Monad m, ScottyError e) => Fail.MonadFail (ActionT e m) where
    fail :: String -> ActionT e m a
fail = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (String
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> String
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionError e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionError e
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (String -> ActionError e)
-> String
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ActionError e
forall e. ScottyError e => String -> e
stringError

instance ( Monad m, ScottyError e
#if !(MIN_VERSION_base(4,8,0))
         , Functor m
#endif
         ) => Alternative (ActionT e m) where
    empty :: ActionT e m a
empty = ActionT e m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: ActionT e m a -> ActionT e m a -> ActionT e m a
(<|>) = ActionT e m a -> ActionT e m a -> ActionT e m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (Monad m, ScottyError e) => MonadPlus (ActionT e m) where
    mzero :: ActionT e m a
mzero = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (Either (ActionError e) a
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> Either (ActionError e) a
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT
   ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (Either (ActionError e) a
    -> ReaderT
         ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a))
-> Either (ActionError e) a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ActionError e) a
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError e) a -> ActionT e m a)
-> Either (ActionError e) a -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ ActionError e -> Either (ActionError e) a
forall a b. a -> Either a b
Left ActionError e
forall e. ActionError e
Next
    ActionT m :: ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m mplus :: ActionT e m a -> ActionT e m a -> ActionT e m a
`mplus` ActionT n :: ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
n = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (ReaderT
      ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT
   ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
 -> ActionT e m a)
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
-> ActionT e m a
forall a b. (a -> b) -> a -> b
$ do
        Either (ActionError e) a
a <- ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m
        case Either (ActionError e) a
a of
            Left  _ -> ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
n
            Right r :: a
r -> Either (ActionError e) a
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError e) a
 -> ReaderT
      ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a))
-> Either (ActionError e) a
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (ActionError e) a
forall a b. b -> Either a b
Right a
r

instance MonadTrans (ActionT e) where
    lift :: m a -> ActionT e m a
lift = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (m a
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> m a
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ActionEnv (StateT ScottyResponse m) a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ActionEnv (StateT ScottyResponse m) a
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (m a -> ReaderT ActionEnv (StateT ScottyResponse m) a)
-> m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ScottyResponse m a
-> ReaderT ActionEnv (StateT ScottyResponse m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ScottyResponse m a
 -> ReaderT ActionEnv (StateT ScottyResponse m) a)
-> (m a -> StateT ScottyResponse m a)
-> m a
-> ReaderT ActionEnv (StateT ScottyResponse m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT ScottyResponse m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (ScottyError e, Monad m) => MonadError (ActionError e) (ActionT e m) where
    throwError :: ActionError e -> ActionT e m a
throwError = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (ActionError e
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> ActionError e
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionError e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

    catchError :: ActionT e m a -> (ActionError e -> ActionT e m a) -> ActionT e m a
catchError (ActionT m :: ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m) f :: ActionError e -> ActionT e m a
f = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> (ActionError e
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m (ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM (ActionT e m a
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (ActionError e -> ActionT e m a)
-> ActionError e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionError e -> ActionT e m a
f))


instance (MonadBase b m, ScottyError e) => MonadBase b (ActionT e m) where
    liftBase :: b α -> ActionT e m α
liftBase = b α -> ActionT e m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault


instance (MonadThrow m, ScottyError e) => MonadThrow (ActionT e m) where
    throwM :: e -> ActionT e m a
throwM = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (e
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> e
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance (MonadCatch m, ScottyError e) => MonadCatch (ActionT e m) where
    catch :: ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
catch (ActionT m :: ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m) f :: e -> ActionT e m a
f = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
m ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> (e
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM (ActionT e m a
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (e -> ActionT e m a)
-> e
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ActionT e m a
f))

instance MonadTransControl (ActionT e) where
     type StT (ActionT e) a = StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a))
     liftWith :: (Run (ActionT e) -> m a) -> ActionT e m a
liftWith = \f :: Run (ActionT e) -> m a
f ->
        ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall a b. (a -> b) -> a -> b
$  (Run (ExceptT (ActionError e))
 -> ReaderT ActionEnv (StateT ScottyResponse m) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ExceptT (ActionError e))
  -> ReaderT ActionEnv (StateT ScottyResponse m) a)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (Run (ExceptT (ActionError e))
    -> ReaderT ActionEnv (StateT ScottyResponse m) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall a b. (a -> b) -> a -> b
$ \run :: Run (ExceptT (ActionError e))
run  ->
                   (Run (ReaderT ActionEnv) -> StateT ScottyResponse m a)
-> ReaderT ActionEnv (StateT ScottyResponse m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ReaderT ActionEnv) -> StateT ScottyResponse m a)
 -> ReaderT ActionEnv (StateT ScottyResponse m) a)
-> (Run (ReaderT ActionEnv) -> StateT ScottyResponse m a)
-> ReaderT ActionEnv (StateT ScottyResponse m) a
forall a b. (a -> b) -> a -> b
$ \run' :: Run (ReaderT ActionEnv)
run' ->
                   (Run (StateT ScottyResponse) -> m a) -> StateT ScottyResponse m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (StateT ScottyResponse) -> m a) -> StateT ScottyResponse m a)
-> (Run (StateT ScottyResponse) -> m a)
-> StateT ScottyResponse m a
forall a b. (a -> b) -> a -> b
$ \run'' :: Run (StateT ScottyResponse)
run'' ->
                   Run (ActionT e) -> m a
f (Run (ActionT e) -> m a) -> Run (ActionT e) -> m a
forall a b. (a -> b) -> a -> b
$ StateT ScottyResponse n (Either (ActionError e) b)
-> n (Either (ActionError e) b, ScottyResponse)
Run (StateT ScottyResponse)
run'' (StateT ScottyResponse n (Either (ActionError e) b)
 -> n (Either (ActionError e) b, ScottyResponse))
-> (ActionT e n b
    -> StateT ScottyResponse n (Either (ActionError e) b))
-> ActionT e n b
-> n (Either (ActionError e) b, ScottyResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b)
-> StateT ScottyResponse n (Either (ActionError e) b)
Run (ReaderT ActionEnv)
run' (ReaderT
   ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b)
 -> StateT ScottyResponse n (Either (ActionError e) b))
-> (ActionT e n b
    -> ReaderT
         ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b))
-> ActionT e n b
-> StateT ScottyResponse n (Either (ActionError e) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse n)) b
-> ReaderT
     ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b)
Run (ExceptT (ActionError e))
run (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse n)) b
 -> ReaderT
      ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b))
-> (ActionT e n b
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse n)) b)
-> ActionT e n b
-> ReaderT
     ActionEnv (StateT ScottyResponse n) (Either (ActionError e) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionT e n b
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse n)) b
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM
     restoreT :: m (StT (ActionT e) a) -> ActionT e m a
restoreT = ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
forall e (m :: * -> *) a.
ExceptT
  (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
-> ActionT e m a
ActionT (ExceptT
   (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
 -> ActionT e m a)
-> (m (Either (ActionError e) a, ScottyResponse)
    -> ExceptT
         (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> m (Either (ActionError e) a, ScottyResponse)
-> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (ReaderT
   ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
 -> ExceptT
      (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (m (Either (ActionError e) a, ScottyResponse)
    -> ReaderT
         ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a))
-> m (Either (ActionError e) a, ScottyResponse)
-> ExceptT
     (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ScottyResponse m (Either (ActionError e) a)
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (StateT ScottyResponse m (Either (ActionError e) a)
 -> ReaderT
      ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a))
-> (m (Either (ActionError e) a, ScottyResponse)
    -> StateT ScottyResponse m (Either (ActionError e) a))
-> m (Either (ActionError e) a, ScottyResponse)
-> ReaderT
     ActionEnv (StateT ScottyResponse m) (Either (ActionError e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (ActionError e) a, ScottyResponse)
-> StateT ScottyResponse m (Either (ActionError e) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

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

------------------ Scotty Routes --------------------
data RoutePattern = Capture   Text
                  | Literal   Text
                  | Function  (Request -> Maybe [Param])

instance IsString RoutePattern where
    fromString :: String -> RoutePattern
fromString = Text -> RoutePattern
Capture (Text -> RoutePattern)
-> (String -> Text) -> String -> RoutePattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack