{-# 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)
data Options = Options { Options -> Int
verbose :: Int
, Options -> Settings
settings :: Settings
}
instance Default Options where
def :: Options
def = Int -> Settings -> Options
Options 1 Settings
defaultSettings
type Middleware m = Application m -> Application m
type Application m = Request -> m Response
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 )
data ActionError e = Redirect Text
| Next
| Finish
| ActionError e
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 ())
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]
| 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
, :: 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
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