{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Web.Simple.Controller
(
Controller, T.ControllerT(..)
, controllerApp, controllerState, putState
, request, localRequest, respond
, requestHeader
, routeHost, routeTop, routeMethod, routeAccept
, routePattern, routeName, routeVar
, T.Parseable
, queryParam, queryParam', queryParams
, readQueryParam, readQueryParam', readQueryParams
, parseForm
, redirectBack
, redirectBackOr
, T.ControllerException
, body
, hoistEither
) where
import Control.Monad.IO.Class
import Blaze.ByteString.Builder
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.Text (Text)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Parse
import Web.Simple.Controller.Trans
(ControllerT)
import qualified Web.Simple.Controller.Trans as T
import Web.Simple.Responses
type Controller s = ControllerT s IO
hoistEither :: Either Response a -> Controller s a
hoistEither :: forall a s. Either Response a -> Controller s a
hoistEither = forall (m :: * -> *) a s.
Monad m =>
Either Response a -> ControllerT s m a
T.hoistEither
request :: Controller s Request
request :: forall s. Controller s Request
request = forall (m :: * -> *) s. Monad m => ControllerT s m Request
T.request
localRequest :: (Request -> Request) -> Controller s a -> Controller s a
localRequest :: forall s a.
(Request -> Request) -> Controller s a -> Controller s a
localRequest = forall (m :: * -> *) s a.
Monad m =>
(Request -> Request) -> ControllerT s m a -> ControllerT s m a
T.localRequest
controllerState :: Controller s s
controllerState :: forall s. Controller s s
controllerState = forall (m :: * -> *) s. Monad m => ControllerT s m s
T.controllerState
putState :: s -> Controller s ()
putState :: forall s. s -> Controller s ()
putState = forall (m :: * -> *) s. Monad m => s -> ControllerT s m ()
T.putState
controllerApp :: s -> Controller s a -> Application
controllerApp :: forall s a. s -> Controller s a -> Application
controllerApp s
s Controller s a
ctrl Request
req Response -> IO ResponseReceived
responseFunc = do
Response
resp <- forall (m :: * -> *) s a.
Monad m =>
s -> ControllerT s m a -> SimpleApplication m
T.controllerApp s
s Controller s a
ctrl Request
req
Response -> IO ResponseReceived
responseFunc Response
resp
respond :: Response -> Controller s a
respond :: forall s a. Response -> Controller s a
respond = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
T.respond
routeHost :: S.ByteString -> Controller s a -> Controller s ()
routeHost :: forall s a. ByteString -> Controller s a -> Controller s ()
routeHost = forall (m :: * -> *) s a.
Monad m =>
ByteString -> ControllerT s m a -> ControllerT s m ()
T.routeHost
routeTop :: Controller s a -> Controller s ()
routeTop :: forall s a. Controller s a -> Controller s ()
routeTop = forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
T.routeTop
routeMethod :: StdMethod -> Controller s a -> Controller s ()
routeMethod :: forall s a. StdMethod -> Controller s a -> Controller s ()
routeMethod = forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
T.routeMethod
routeAccept :: S8.ByteString -> Controller s a -> Controller s ()
routeAccept :: forall s a. ByteString -> Controller s a -> Controller s ()
routeAccept = forall (m :: * -> *) s a.
Monad m =>
ByteString -> ControllerT s m a -> ControllerT s m ()
T.routeAccept
routePattern :: Text -> Controller s a -> Controller s ()
routePattern :: forall s a. Text -> Controller s a -> Controller s ()
routePattern = forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
T.routePattern
routeName :: Text -> Controller s a -> Controller s ()
routeName :: forall s a. Text -> Controller s a -> Controller s ()
routeName = forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
T.routeName
routeVar :: Text -> Controller s a -> Controller s ()
routeVar :: forall s a. Text -> Controller s a -> Controller s ()
routeVar = forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
T.routeVar
queryParam :: T.Parseable a
=> S8.ByteString
-> Controller s (Maybe a)
queryParam :: forall a s. Parseable a => ByteString -> Controller s (Maybe a)
queryParam = forall (m :: * -> *) a s.
(Monad m, Parseable a) =>
ByteString -> ControllerT s m (Maybe a)
T.queryParam
queryParam' :: T.Parseable a
=> S.ByteString -> Controller s a
queryParam' :: forall a s. Parseable a => ByteString -> Controller s a
queryParam' = forall (m :: * -> *) a s.
(Monad m, Parseable a) =>
ByteString -> ControllerT s m a
T.queryParam'
queryParams :: T.Parseable a
=> S.ByteString -> Controller s [a]
queryParams :: forall a s. Parseable a => ByteString -> Controller s [a]
queryParams = forall (m :: * -> *) a s.
(Monad m, Parseable a) =>
ByteString -> ControllerT s m [a]
T.queryParams
readQueryParam :: Read a
=> S8.ByteString
-> Controller s (Maybe a)
readQueryParam :: forall a s. Read a => ByteString -> Controller s (Maybe a)
readQueryParam = forall (m :: * -> *) a s.
(Monad m, Read a) =>
ByteString -> ControllerT s m (Maybe a)
T.readQueryParam
readQueryParam' :: Read a
=> S8.ByteString
-> Controller s a
readQueryParam' :: forall a s. Read a => ByteString -> Controller s a
readQueryParam' = forall (m :: * -> *) a s.
(Monad m, Read a) =>
ByteString -> ControllerT s m a
T.readQueryParam'
readQueryParams :: Read a
=> S8.ByteString
-> Controller s [a]
readQueryParams :: forall a s. Read a => ByteString -> Controller s [a]
readQueryParams = forall (m :: * -> *) a s.
(Monad m, Read a) =>
ByteString -> ControllerT s m [a]
T.readQueryParams
parseForm :: Controller s ([Param], [(S.ByteString, FileInfo L.ByteString)])
parseForm :: forall s.
Controller s ([Param], [(ByteString, FileInfo ByteString)])
parseForm = do
Request
req <- forall s. Controller s Request
request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall y. BackEnd y -> Request -> IO ([Param], [File y])
parseRequestBody forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
lbsBackEnd Request
req
body :: Controller s L8.ByteString
body :: forall s. Controller s ByteString
body = do
IO ByteString
bodyProducer <- Request -> IO ByteString
getRequestBodyChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s. Controller s Request
request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Builder
result <- forall {m :: * -> *}.
Monad m =>
Builder -> m ByteString -> m Builder
consume forall a. Monoid a => a
mempty IO ByteString
bodyProducer
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
result
where consume :: Builder -> m ByteString -> m Builder
consume Builder
bldr m ByteString
prod = do
ByteString
next <- m ByteString
prod
if ByteString -> Bool
S.null ByteString
next then
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
bldr
else Builder -> m ByteString -> m Builder
consume (forall a. Monoid a => a -> a -> a
mappend Builder
bldr (ByteString -> Builder
fromByteString ByteString
next)) m ByteString
prod
requestHeader :: HeaderName -> Controller s (Maybe S8.ByteString)
HeaderName
name = forall s. Controller s Request
request forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestHeaders
requestHeaders
redirectBack :: Controller s a
redirectBack :: forall s a. Controller s a
redirectBack = forall s a. Response -> Controller s a
redirectBackOr (ByteString -> Response
redirectTo ByteString
"/")
redirectBackOr :: Response
-> Controller s a
redirectBackOr :: forall s a. Response -> Controller s a
redirectBackOr Response
def = do
Maybe ByteString
mrefr <- forall s. HeaderName -> Controller s (Maybe ByteString)
requestHeader HeaderName
"referer"
case Maybe ByteString
mrefr of
Just ByteString
refr -> forall s a. Response -> Controller s a
respond forall a b. (a -> b) -> a -> b
$ ByteString -> Response
redirectTo ByteString
refr
Maybe ByteString
Nothing -> forall s a. Response -> Controller s a
respond Response
def