{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module Web.Scotty.Trans
(
scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..)
, middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound
, capture, regex, function, literal
, request, header, headers, body, bodyReader, param, params, jsonData, files
, status, addHeader, setHeader, redirect
, text, html, file, json, stream, raw
, raise, rescue, next, finish, defaultHandler, ScottyError(..), liftAndCatchIO
, Param, Parsable(..), readEither
, RoutePattern, File
, ScottyT, ActionT
) where
import Blaze.ByteString.Builder (fromByteString)
import Control.Monad (when)
import Control.Monad.State (execState, modify)
import Control.Monad.IO.Class
import Data.Default.Class (def)
import Network.HTTP.Types (status404, status500)
import Network.Socket (Socket)
import Network.Wai
import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort)
import Web.Scotty.Action
import Web.Scotty.Route
import Web.Scotty.Internal.Types hiding (Application, Middleware)
import Web.Scotty.Util (socketDescription)
import qualified Web.Scotty.Internal.Types as Scotty
scottyT :: (Monad m, MonadIO n)
=> Port
-> (m Response -> IO Response)
-> ScottyT e m ()
-> n ()
scottyT :: Port -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyT p :: Port
p = Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyOptsT (Options -> (m Response -> IO Response) -> ScottyT e m () -> n ())
-> Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
forall a b. (a -> b) -> a -> b
$ Options
forall a. Default a => a
def { settings :: Settings
settings = Port -> Settings -> Settings
setPort Port
p (Options -> Settings
settings Options
forall a. Default a => a
def) }
scottyOptsT :: (Monad m, MonadIO n)
=> Options
-> (m Response -> IO Response)
-> ScottyT e m ()
-> n ()
scottyOptsT :: Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottyOptsT opts :: Options
opts runActionToIO :: m Response -> IO Response
runActionToIO s :: ScottyT e m ()
s = do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Setting phasers to stun... (port " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show (Settings -> Port
getPort (Options -> Settings
settings Options
opts)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") (ctrl-c to quit)"
IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> (Application -> IO ()) -> Application -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Application -> IO ()
runSettings (Options -> Settings
settings Options
opts) (Application -> n ()) -> n Application -> n ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (m Response -> IO Response) -> ScottyT e m () -> n Application
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT e m ()
s
scottySocketT :: (Monad m, MonadIO n)
=> Options
-> Socket
-> (m Response -> IO Response)
-> ScottyT e m ()
-> n ()
scottySocketT :: Options
-> Socket -> (m Response -> IO Response) -> ScottyT e m () -> n ()
scottySocketT opts :: Options
opts sock :: Socket
sock runActionToIO :: m Response -> IO Response
runActionToIO s :: ScottyT e m ()
s = do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Port
verbose Options
opts Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ do
String
d <- IO String -> n String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> n String) -> IO String -> n String
forall a b. (a -> b) -> a -> b
$ Socket -> IO String
socketDescription Socket
sock
IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Setting phasers to stun... (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") (ctrl-c to quit)"
IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> (Application -> IO ()) -> Application -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Socket -> Application -> IO ()
runSettingsSocket (Options -> Settings
settings Options
opts) Socket
sock (Application -> n ()) -> n Application -> n ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (m Response -> IO Response) -> ScottyT e m () -> n Application
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, Monad n) =>
(m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT m Response -> IO Response
runActionToIO ScottyT e m ()
s
scottyAppT :: (Monad m, Monad n)
=> (m Response -> IO Response)
-> ScottyT e m ()
-> n Application
scottyAppT :: (m Response -> IO Response) -> ScottyT e m () -> n Application
scottyAppT runActionToIO :: m Response -> IO Response
runActionToIO defs :: ScottyT e m ()
defs = do
let s :: ScottyState e m
s = State (ScottyState e m) () -> ScottyState e m -> ScottyState e m
forall s a. State s a -> s -> s
execState (ScottyT e m () -> State (ScottyState e m) ()
forall e (m :: * -> *) a.
ScottyT e m a -> State (ScottyState e m) a
runS ScottyT e m ()
defs) ScottyState e m
forall a. Default a => a
def
let rapp :: Request -> (Response -> IO b) -> IO b
rapp req :: Request
req callback :: Response -> IO b
callback = m Response -> IO Response
runActionToIO ((Application m
-> (Application m -> Application m) -> Application m)
-> Application m
-> [Application m -> Application m]
-> Application m
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Application m -> Application m)
-> Application m -> Application m)
-> Application m
-> (Application m -> Application m)
-> Application m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Application m -> Application m) -> Application m -> Application m
forall a b. (a -> b) -> a -> b
($)) Application m
forall (m :: * -> *). Monad m => Application m
notFoundApp (ScottyState e m -> [Application m -> Application m]
forall e (m :: * -> *). ScottyState e m -> [Middleware m]
routes ScottyState e m
s) Request
req) IO Response -> (Response -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO b
callback
Application -> n Application
forall (m :: * -> *) a. Monad m => a -> m a
return (Application -> n Application) -> Application -> n Application
forall a b. (a -> b) -> a -> b
$ (Application -> (Application -> Application) -> Application)
-> Application -> [Application -> Application] -> Application
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Application -> Application) -> Application -> Application)
-> Application -> (Application -> Application) -> Application
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Application -> Application) -> Application -> Application
forall a b. (a -> b) -> a -> b
($)) Application
forall b. Request -> (Response -> IO b) -> IO b
rapp (ScottyState e m -> [Application -> Application]
forall e (m :: * -> *).
ScottyState e m -> [Application -> Application]
middlewares ScottyState e m
s)
notFoundApp :: Monad m => Scotty.Application m
notFoundApp :: Application m
notFoundApp _ = Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response) -> Response -> m Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
status404 [("Content-Type","text/html")]
(Builder -> Response) -> Builder -> Response
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString "<h1>404: File Not Found!</h1>"
defaultHandler :: (ScottyError e, Monad m) => (e -> ActionT e m ()) -> ScottyT e m ()
defaultHandler :: (e -> ActionT e m ()) -> ScottyT e m ()
defaultHandler f :: e -> ActionT e m ()
f = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> State (ScottyState e m) () -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ())
-> (ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ()
forall a b. (a -> b) -> a -> b
$ ErrorHandler e m -> ScottyState e m -> ScottyState e m
forall e (m :: * -> *).
ErrorHandler e m -> ScottyState e m -> ScottyState e m
addHandler (ErrorHandler e m -> ScottyState e m -> ScottyState e m)
-> ErrorHandler e m -> ScottyState e m -> ScottyState e m
forall a b. (a -> b) -> a -> b
$ (e -> ActionT e m ()) -> ErrorHandler e m
forall a. a -> Maybe a
Just (\e :: e
e -> Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status500 ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> ActionT e m ()
f e
e)
middleware :: Middleware -> ScottyT e m ()
middleware :: (Application -> Application) -> ScottyT e m ()
middleware = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> ((Application -> Application) -> State (ScottyState e m) ())
-> (Application -> Application)
-> ScottyT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ())
-> ((Application -> Application)
-> ScottyState e m -> ScottyState e m)
-> (Application -> Application)
-> State (ScottyState e m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Application -> Application) -> ScottyState e m -> ScottyState e m
forall e (m :: * -> *).
(Application -> Application) -> ScottyState e m -> ScottyState e m
addMiddleware