{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Web.Scotty.Action
( addHeader
, body
, bodyReader
, file
, files
, finish
, header
, headers
, html
, liftAndCatchIO
, json
, jsonData
, next
, param
, params
, raise
, raw
, readEither
, redirect
, request
, rescue
, setHeader
, status
, stream
, text
, Param
, Parsable(..)
, runAction
) where
import Blaze.ByteString.Builder (fromLazyByteString)
import qualified Control.Exception as E
import Control.Monad.Error.Class
import Control.Monad.Reader
import qualified Control.Monad.State as MS
import Control.Monad.Trans.Except
import qualified Data.Aeson as A
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.CaseInsensitive as CI
import Data.Default.Class (def)
import Data.Int
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (mconcat)
#endif
import qualified Data.Text as ST
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Word
import Network.HTTP.Types
import Network.Wai
import Numeric.Natural
import Web.Scotty.Internal.Types
import Web.Scotty.Util
runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction :: ErrorHandler e m
-> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction h :: ErrorHandler e m
h env :: ActionEnv
env action :: ActionT e m ()
action = do
(e :: Either (ActionError e) ()
e,r :: ScottyResponse
r) <- (StateT ScottyResponse m (Either (ActionError e) ())
-> ScottyResponse -> m (Either (ActionError e) (), ScottyResponse))
-> ScottyResponse
-> StateT ScottyResponse m (Either (ActionError e) ())
-> m (Either (ActionError e) (), ScottyResponse)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ScottyResponse m (Either (ActionError e) ())
-> ScottyResponse -> m (Either (ActionError e) (), ScottyResponse)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT ScottyResponse
forall a. Default a => a
def
(StateT ScottyResponse m (Either (ActionError e) ())
-> m (Either (ActionError e) (), ScottyResponse))
-> StateT ScottyResponse m (Either (ActionError e) ())
-> m (Either (ActionError e) (), ScottyResponse)
forall a b. (a -> b) -> a -> b
$ (ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> ActionEnv
-> StateT ScottyResponse m (Either (ActionError e) ()))
-> ActionEnv
-> ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> StateT ScottyResponse m (Either (ActionError e) ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> ActionEnv -> StateT ScottyResponse m (Either (ActionError e) ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ActionEnv
env
(ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> StateT ScottyResponse m (Either (ActionError e) ()))
-> ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
-> StateT ScottyResponse m (Either (ActionError e) ())
forall a b. (a -> b) -> a -> b
$ ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ()))
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ReaderT
ActionEnv (StateT ScottyResponse m) (Either (ActionError e) ())
forall a b. (a -> b) -> a -> b
$ ActionT e m ()
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall e (m :: * -> *) a.
ActionT e m a
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
runAM
(ActionT e m ()
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> ActionT e m ()
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall a b. (a -> b) -> a -> b
$ ActionT e m ()
action ActionT e m ()
-> (ActionError e -> ActionT e m ()) -> ActionT e m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (ErrorHandler e m -> ActionError e -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m -> ActionError e -> ActionT e m ()
defH ErrorHandler e m
h)
Maybe Response -> m (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> m (Maybe Response))
-> Maybe Response -> m (Maybe Response)
forall a b. (a -> b) -> a -> b
$ (ActionError e -> Maybe Response)
-> (() -> Maybe Response)
-> Either (ActionError e) ()
-> Maybe Response
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Response -> ActionError e -> Maybe Response
forall a b. a -> b -> a
const Maybe Response
forall a. Maybe a
Nothing) (Maybe Response -> () -> Maybe Response
forall a b. a -> b -> a
const (Maybe Response -> () -> Maybe Response)
-> Maybe Response -> () -> Maybe Response
forall a b. (a -> b) -> a -> b
$ Response -> Maybe Response
forall a. a -> Maybe a
Just (Response -> Maybe Response) -> Response -> Maybe Response
forall a b. (a -> b) -> a -> b
$ ScottyResponse -> Response
mkResponse ScottyResponse
r) Either (ActionError e) ()
e
defH :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionError e -> ActionT e m ()
defH :: ErrorHandler e m -> ActionError e -> ActionT e m ()
defH _ (Redirect url :: Text
url) = do
Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status302
Text -> Text -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
setHeader "Location" Text
url
defH Nothing (ActionError e :: e
e) = do
Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status500
Text -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
html (Text -> ActionT e m ()) -> Text -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["<h1>500 Internal Server Error</h1>", e -> Text
forall e. ScottyError e => e -> Text
showError e
e]
defH h :: ErrorHandler e m
h@(Just f :: e -> ActionT e m ()
f) (ActionError e :: e
e) = e -> ActionT e m ()
f e
e ActionT e m ()
-> (ActionError e -> ActionT e m ()) -> ActionT e m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (ErrorHandler e m -> ActionError e -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m -> ActionError e -> ActionT e m ()
defH ErrorHandler e m
h)
defH _ Next = ActionT e m ()
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
next
defH _ Finish = () -> ActionT e m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
raise :: (ScottyError e, Monad m) => e -> ActionT e m a
raise :: e -> ActionT e m a
raise = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionError e -> ActionT e m a)
-> (e -> ActionError e) -> e -> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ActionError e
forall e. e -> ActionError e
ActionError
next :: (ScottyError e, Monad m) => ActionT e m a
next :: ActionT e m a
next = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
forall e. ActionError e
Next
rescue :: (ScottyError e, Monad m) => ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
rescue :: ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
rescue action :: ActionT e m a
action h :: e -> ActionT e m a
h = ActionT e m a -> (ActionError e -> ActionT e m a) -> ActionT e m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ActionT e m a
action ((ActionError e -> ActionT e m a) -> ActionT e m a)
-> (ActionError e -> ActionT e m a) -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ \e :: ActionError e
e -> case ActionError e
e of
ActionError err :: e
err -> e -> ActionT e m a
h e
err
other :: ActionError e
other -> ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
other
liftAndCatchIO :: (ScottyError e, MonadIO m) => IO a -> ActionT e m a
liftAndCatchIO :: IO a -> ActionT e m a
liftAndCatchIO io :: IO a
io = 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
$ do
Either (ActionError e) a
r <- IO (Either (ActionError e) a)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Either (ActionError e) a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (ActionError e) a)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Either (ActionError e) a))
-> IO (Either (ActionError e) a)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Either (ActionError e) a)
forall a b. (a -> b) -> a -> b
$ (a -> Either (ActionError e) a)
-> IO a -> IO (Either (ActionError e) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either (ActionError e) a
forall a b. b -> Either a b
Right IO a
io IO (Either (ActionError e) a)
-> (SomeException -> IO (Either (ActionError e) a))
-> IO (Either (ActionError e) a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ e :: SomeException
e -> Either (ActionError e) a -> IO (Either (ActionError e) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError e) a -> IO (Either (ActionError e) a))
-> Either (ActionError e) a -> IO (Either (ActionError e) a)
forall a b. (a -> b) -> a -> b
$ ActionError e -> Either (ActionError e) a
forall a b. a -> Either a b
Left (ActionError e -> Either (ActionError e) a)
-> ActionError e -> Either (ActionError e) a
forall a b. (a -> b) -> a -> b
$ String -> ActionError e
forall e. ScottyError e => String -> e
stringError (String -> ActionError e) -> String -> ActionError e
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: E.SomeException))
(ActionError e
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> (a
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a)
-> Either (ActionError e) a
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ActionError e
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (ActionError e) a
r
redirect :: (ScottyError e, Monad m) => T.Text -> ActionT e m a
redirect :: Text -> ActionT e m a
redirect = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionError e -> ActionT e m a)
-> (Text -> ActionError e) -> Text -> ActionT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ActionError e
forall e. Text -> ActionError e
Redirect
finish :: (ScottyError e, Monad m) => ActionT e m a
finish :: ActionT e m a
finish = ActionError e -> ActionT e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionError e
forall e. ActionError e
Finish
request :: Monad m => ActionT e m Request
request :: ActionT e m Request
request = ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
Request
-> ActionT e m Request
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))
Request
-> ActionT e m Request)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
Request
-> ActionT e m Request
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> Request)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
Request
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> Request
getReq ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
files :: Monad m => ActionT e m [File]
files :: ActionT e m [File]
files = ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[File]
-> ActionT e m [File]
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))
[File]
-> ActionT e m [File])
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[File]
-> ActionT e m [File]
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> [File])
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> [File]
getFiles ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
header :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text)
k :: Text
k = do
RequestHeaders
hs <- (Request -> RequestHeaders)
-> ActionT e m Request -> ActionT e m RequestHeaders
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> RequestHeaders
requestHeaders ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
request
Maybe Text -> ActionT e m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ActionT e m (Maybe Text))
-> Maybe Text -> ActionT e m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
strictByteStringToLazyText (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
lazyTextToStrictByteString Text
k)) RequestHeaders
hs
headers :: (ScottyError e, Monad m) => ActionT e m [(T.Text, T.Text)]
= do
RequestHeaders
hs <- (Request -> RequestHeaders)
-> ActionT e m Request -> ActionT e m RequestHeaders
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> RequestHeaders
requestHeaders ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
request
[(Text, Text)] -> ActionT e m [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( ByteString -> Text
strictByteStringToLazyText (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
k)
, ByteString -> Text
strictByteStringToLazyText ByteString
v)
| (k :: CI ByteString
k,v :: ByteString
v) <- RequestHeaders
hs ]
body :: (ScottyError e, MonadIO m) => ActionT e m BL.ByteString
body :: ActionT e m ByteString
body = ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ActionT e m ActionEnv
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))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask ActionT e m ActionEnv
-> (ActionEnv -> ActionT e m ByteString) -> ActionT e m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO ByteString -> ActionT e m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionT e m ByteString)
-> (ActionEnv -> IO ByteString)
-> ActionEnv
-> ActionT e m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> IO ByteString
getBody)
bodyReader :: Monad m => ActionT e m (IO B.ByteString)
bodyReader :: ActionT e m (IO ByteString)
bodyReader = ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(IO ByteString)
-> ActionT e m (IO ByteString)
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))
(IO ByteString)
-> ActionT e m (IO ByteString))
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(IO ByteString)
-> ActionT e m (IO ByteString)
forall a b. (a -> b) -> a -> b
$ ActionEnv -> IO ByteString
getBodyChunk (ActionEnv -> IO ByteString)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(IO ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
jsonData :: (A.FromJSON a, ScottyError e, MonadIO m) => ActionT e m a
jsonData :: ActionT e m a
jsonData = do
ByteString
b <- ActionT e m ByteString
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m ByteString
body
(String -> ActionT e m a)
-> (a -> ActionT e m a) -> Either String a -> ActionT e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: String
e -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
raise (e -> ActionT e m a) -> e -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ "jsonData - no parse: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ ". Data was:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BL.unpack ByteString
b) a -> ActionT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> ActionT e m a)
-> Either String a -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
b
param :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a
param :: Text -> ActionT e m a
param k :: Text
k = do
Maybe Text
val <- ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Maybe Text)
-> ActionT e m (Maybe Text)
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))
(Maybe Text)
-> ActionT e m (Maybe Text))
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Maybe Text)
-> ActionT e m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> Maybe Text)
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
(Maybe Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([(Text, Text)] -> Maybe Text)
-> (ActionEnv -> [(Text, Text)]) -> ActionEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionEnv -> [(Text, Text)]
getParams) ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
case Maybe Text
val of
Nothing -> e -> ActionT e m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
raise (e -> ActionT e m a) -> e -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ String -> e
forall e. ScottyError e => String -> e
stringError (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ "Param: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ " not found!"
Just v :: Text
v -> (Text -> ActionT e m a)
-> (a -> ActionT e m a) -> Either Text a -> ActionT e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT e m a -> Text -> ActionT e m a
forall a b. a -> b -> a
const ActionT e m a
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
next) a -> ActionT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> ActionT e m a) -> Either Text a -> ActionT e m a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam Text
v
params :: Monad m => ActionT e m [Param]
params :: ActionT e m [(Text, Text)]
params = ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[(Text, Text)]
-> ActionT e m [(Text, Text)]
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))
[(Text, Text)]
-> ActionT e m [(Text, Text)])
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[(Text, Text)]
-> ActionT e m [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (ActionEnv -> [(Text, Text)])
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
-> ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
[(Text, Text)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ActionEnv -> [(Text, Text)]
getParams ExceptT
(ActionError e)
(ReaderT ActionEnv (StateT ScottyResponse m))
ActionEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
class Parsable a where
parseParam :: T.Text -> Either T.Text a
parseParamList :: T.Text -> Either T.Text [a]
parseParamList t :: Text
t = (Text -> Either Text a) -> [Text] -> Either Text [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text a
forall a. Parsable a => Text -> Either Text a
parseParam ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',') Text
t)
instance Parsable T.Text where parseParam :: Text -> Either Text Text
parseParam = Text -> Either Text Text
forall a b. b -> Either a b
Right
instance Parsable ST.Text where parseParam :: Text -> Either Text Text
parseParam = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (Text -> Text) -> Text -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toStrict
instance Parsable B.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
lazyTextToStrictByteString
instance Parsable BL.ByteString where parseParam :: Text -> Either Text ByteString
parseParam = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
instance Parsable Char where
parseParam :: Text -> Either Text Char
parseParam t :: Text
t = case Text -> String
T.unpack Text
t of
[c :: Char
c] -> Char -> Either Text Char
forall a b. b -> Either a b
Right Char
c
_ -> Text -> Either Text Char
forall a b. a -> Either a b
Left "parseParam Char: no parse"
parseParamList :: Text -> Either Text String
parseParamList = String -> Either Text String
forall a b. b -> Either a b
Right (String -> Either Text String)
-> (Text -> String) -> Text -> Either Text String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance Parsable () where
parseParam :: Text -> Either Text ()
parseParam t :: Text
t = if Text -> Bool
T.null Text
t then () -> Either Text ()
forall a b. b -> Either a b
Right () else Text -> Either Text ()
forall a b. a -> Either a b
Left "parseParam Unit: no parse"
instance (Parsable a) => Parsable [a] where parseParam :: Text -> Either Text [a]
parseParam = Text -> Either Text [a]
forall a. Parsable a => Text -> Either Text [a]
parseParamList
instance Parsable Bool where
parseParam :: Text -> Either Text Bool
parseParam t :: Text
t = if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold "true"
then Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
else if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold "false"
then Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
else Text -> Either Text Bool
forall a b. a -> Either a b
Left "parseParam Bool: no parse"
where t' :: Text
t' = Text -> Text
T.toCaseFold Text
t
instance Parsable Double where parseParam :: Text -> Either Text Double
parseParam = Text -> Either Text Double
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Float where parseParam :: Text -> Either Text Float
parseParam = Text -> Either Text Float
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int where parseParam :: Text -> Either Text Int
parseParam = Text -> Either Text Int
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int8 where parseParam :: Text -> Either Text Int8
parseParam = Text -> Either Text Int8
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int16 where parseParam :: Text -> Either Text Int16
parseParam = Text -> Either Text Int16
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int32 where parseParam :: Text -> Either Text Int32
parseParam = Text -> Either Text Int32
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Int64 where parseParam :: Text -> Either Text Int64
parseParam = Text -> Either Text Int64
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Integer where parseParam :: Text -> Either Text Integer
parseParam = Text -> Either Text Integer
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word where parseParam :: Text -> Either Text Word
parseParam = Text -> Either Text Word
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word8 where parseParam :: Text -> Either Text Word8
parseParam = Text -> Either Text Word8
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word16 where parseParam :: Text -> Either Text Word16
parseParam = Text -> Either Text Word16
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word32 where parseParam :: Text -> Either Text Word32
parseParam = Text -> Either Text Word32
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Word64 where parseParam :: Text -> Either Text Word64
parseParam = Text -> Either Text Word64
forall a. Read a => Text -> Either Text a
readEither
instance Parsable Natural where parseParam :: Text -> Either Text Natural
parseParam = Text -> Either Text Natural
forall a. Read a => Text -> Either Text a
readEither
readEither :: Read a => T.Text -> Either T.Text a
readEither :: Text -> Either Text a
readEither t :: Text
t = case [ a
x | (x :: a
x,"") <- ReadS a
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
t) ] of
[x :: a
x] -> a -> Either Text a
forall a b. b -> Either a b
Right a
x
[] -> Text -> Either Text a
forall a b. a -> Either a b
Left "readEither: no parse"
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left "readEither: ambiguous parse"
status :: Monad m => Status -> ActionT e m ()
status :: Status -> ActionT e m ()
status = ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
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)) ()
-> ActionT e m ())
-> (Status
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> Status
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (Status -> ScottyResponse -> ScottyResponse)
-> Status
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ScottyResponse -> ScottyResponse
setStatus
changeHeader :: Monad m
=> (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)])
-> T.Text -> T.Text -> ActionT e m ()
f :: CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f k :: Text
k = ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
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)) ()
-> ActionT e m ())
-> (Text
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> Text
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify
((ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (Text -> ScottyResponse -> ScottyResponse)
-> Text
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestHeaders -> RequestHeaders)
-> ScottyResponse -> ScottyResponse
setHeaderWith
((RequestHeaders -> RequestHeaders)
-> ScottyResponse -> ScottyResponse)
-> (Text -> RequestHeaders -> RequestHeaders)
-> Text
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
f (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
lazyTextToStrictByteString Text
k)
(ByteString -> RequestHeaders -> RequestHeaders)
-> (Text -> ByteString) -> Text -> RequestHeaders -> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
lazyTextToStrictByteString
addHeader :: Monad m => T.Text -> T.Text -> ActionT e m ()
= (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. a -> b -> [(a, b)] -> [(a, b)]
add
setHeader :: Monad m => T.Text -> T.Text -> ActionT e m ()
= (CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
replace
text :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
text :: Text -> ActionT e m ()
text t :: Text
t = do
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent "Content-Type" "text/plain; charset=utf-8"
ByteString -> ActionT e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
html :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
html :: Text -> ActionT e m ()
html t :: Text
t = do
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent "Content-Type" "text/html; charset=utf-8"
ByteString -> ActionT e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
file :: Monad m => FilePath -> ActionT e m ()
file :: String -> ActionT e m ()
file = ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
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)) ()
-> ActionT e m ())
-> (String
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> String
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (String -> ScottyResponse -> ScottyResponse)
-> String
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (String -> Content)
-> String
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Content
ContentFile
json :: (A.ToJSON a, ScottyError e, Monad m) => a -> ActionT e m ()
json :: a -> ActionT e m ()
json v :: a
v = do
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
forall (m :: * -> *) e.
Monad m =>
(CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders)
-> Text -> Text -> ActionT e m ()
changeHeader CI ByteString -> ByteString -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
addIfNotPresent "Content-Type" "application/json; charset=utf-8"
ByteString -> ActionT e m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
raw (ByteString -> ActionT e m ()) -> ByteString -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
v
stream :: Monad m => StreamingBody -> ActionT e m ()
stream :: StreamingBody -> ActionT e m ()
stream = ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
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)) ()
-> ActionT e m ())
-> (StreamingBody
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> StreamingBody
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (StreamingBody -> ScottyResponse -> ScottyResponse)
-> StreamingBody
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (StreamingBody -> Content)
-> StreamingBody
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingBody -> Content
ContentStream
raw :: Monad m => BL.ByteString -> ActionT e m ()
raw :: ByteString -> ActionT e m ()
raw = ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
-> ActionT e m ()
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)) ()
-> ActionT e m ())
-> (ByteString
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> ByteString
-> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyResponse -> ScottyResponse)
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ())
-> (ByteString -> ScottyResponse -> ScottyResponse)
-> ByteString
-> ExceptT
(ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ScottyResponse -> ScottyResponse
setContent (Content -> ScottyResponse -> ScottyResponse)
-> (ByteString -> Content)
-> ByteString
-> ScottyResponse
-> ScottyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Content
ContentBuilder (Builder -> Content)
-> (ByteString -> Builder) -> ByteString -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString