    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleInstances #-}

    {- | 'Controller' provides a convenient syntax for writting 'Application'
      code as a Monadic action with access to an HTTP request as well as app
      specific data (e.g. a database connection pool, app configuration etc.)
      This module also defines some
      helper functions that leverage this feature. For example, 'redirectBack'
      reads the underlying request to extract the referer and returns a redirect
      response:

      @
        myController = do
          ...
          if badLogin then
            redirectBack
            else
              ...
      @
    -}
    module Web.Simple.Controller
      (
      -- * Example
      -- $Example
      -- * Controller Monad
        Controller, T.ControllerT(..)
      , controllerApp, controllerState, putState
      , request, localRequest, respond
      , requestHeader
      -- * Common Routes
      , routeHost, routeTop, routeMethod, routeAccept
      , routePattern, routeName, routeVar
      -- * Inspecting query
      , T.Parseable
      , queryParam, queryParam', queryParams
      , readQueryParam, readQueryParam', readQueryParams
      , parseForm
      -- * Redirection via referrer
      , redirectBack
      , redirectBackOr
      -- * Exception handling
      , T.ControllerException
      -- * Low-level utilities
      , 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

    -- | The Controller Monad is both a State-like monad which, when run, computes
    -- either a 'Response' or a result. Within the Controller Monad, the remainder
    -- of the computation can be short-circuited by 'respond'ing with a 'Response'.
    type Controller s = ControllerT s IO

    hoistEither :: Either Response a -> Controller s a
    hoistEither :: Either Response a -> Controller s a
    hoistEither = Either Response a -> Controller s a
    forall (m :: * -> *) a s.
    Monad m =>
    Either Response a -> ControllerT s m a
    T.hoistEither

    -- | Extract the request
    request :: Controller s Request
    request :: Controller s Request
    request = Controller s Request
    forall (m :: * -> *) s. Monad m => ControllerT s m Request
    T.request

    -- | Modify the request for the given computation
    localRequest :: (Request -> Request) -> Controller s a -> Controller s a
    localRequest :: (Request -> Request) -> Controller s a -> Controller s a
    localRequest = (Request -> Request) -> Controller s a -> Controller s a
    forall (m :: * -> *) s a.
    Monad m =>
    (Request -> Request) -> ControllerT s m a -> ControllerT s m a
    T.localRequest

    -- | Extract the application-specific state
    controllerState :: Controller s s
    controllerState :: Controller s s
    controllerState = Controller s s
    forall (m :: * -> *) s. Monad m => ControllerT s m s
    T.controllerState

    putState :: s -> Controller s ()
    putState :: s -> Controller s ()
    putState = s -> Controller s ()
    forall (m :: * -> *) s. Monad m => s -> ControllerT s m ()
    T.putState

    -- | Convert the controller into an 'Application'
    controllerApp :: s -> Controller s a -> Application
    controllerApp :: s -> Controller s a -> Application
    controllerApp s :: s
    s ctrl :: Controller s a
    ctrl req :: Request
    req responseFunc :: Response -> IO ResponseReceived
    responseFunc = do
      Response
    resp <- s -> Controller s a -> SimpleApplication IO
    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

    -- | Provide a response
    --
    -- @respond r >>= f === respond r@
    respond :: Response -> Controller s a
    respond :: Response -> Controller s a
    respond = Response -> Controller s a
    forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
    T.respond

    -- | Matches on the hostname from the 'Request'. The route only succeeds on
    -- exact matches.
    routeHost :: S.ByteString -> Controller s a -> Controller s ()
    routeHost :: ByteString -> Controller s a -> Controller s ()
    routeHost = ByteString -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    ByteString -> ControllerT s m a -> ControllerT s m ()
    T.routeHost

    -- | Matches if the path is empty.
    --
    -- Note that this route checks that 'pathInfo'
    -- is empty, so it works as expected in nested contexts that have
    -- popped components from the 'pathInfo' list.
    routeTop :: Controller s a -> Controller s ()
    routeTop :: Controller s a -> Controller s ()
    routeTop = Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    ControllerT s m a -> ControllerT s m ()
    T.routeTop

    -- | Matches on the HTTP request method (e.g. 'GET', 'POST', 'PUT')
    routeMethod :: StdMethod -> Controller s a -> Controller s ()
    routeMethod :: StdMethod -> Controller s a -> Controller s ()
    routeMethod = StdMethod -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    StdMethod -> ControllerT s m a -> ControllerT s m ()
    T.routeMethod

    -- | Matches if the request's Content-Type exactly matches the given string
    routeAccept :: S8.ByteString -> Controller s a -> Controller s ()
    routeAccept :: ByteString -> Controller s a -> Controller s ()
    routeAccept = ByteString -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    ByteString -> ControllerT s m a -> ControllerT s m ()
    T.routeAccept

    -- | Routes the given URL pattern. Patterns can include
    -- directories as well as variable patterns (prefixed with @:@) to be added
    -- to 'queryString' (see 'routeVar')
    --
    --  * \/posts\/:id
    --
    --  * \/posts\/:id\/new
    --
    --  * \/:date\/posts\/:category\/new
    --
    routePattern :: Text -> Controller s a -> Controller s ()
    routePattern :: Text -> Controller s a -> Controller s ()
    routePattern = Text -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    Text -> ControllerT s m a -> ControllerT s m ()
    T.routePattern

    -- | Matches if the first directory in the path matches the given 'ByteString'
    routeName :: Text -> Controller s a -> Controller s ()
    routeName :: Text -> Controller s a -> Controller s ()
    routeName = Text -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    Text -> ControllerT s m a -> ControllerT s m ()
    T.routeName

    -- | Always matches if there is at least one directory in 'pathInfo' but and
    -- adds a parameter to 'queryString' where the key is the first parameter and
    -- the value is the directory consumed from the path.
    routeVar :: Text -> Controller s a -> Controller s ()
    routeVar :: Text -> Controller s a -> Controller s ()
    routeVar = Text -> Controller s a -> Controller s ()
    forall (m :: * -> *) s a.
    Monad m =>
    Text -> ControllerT s m a -> ControllerT s m ()
    T.routeVar

    --
    -- query parameters
    --

    -- | Looks up the parameter name in the request's query string and returns the
    -- @Parseable@ value or 'Nothing'.
    --
    -- For example, for a request with query string: \"?foo=bar&baz=7\",
    -- @queryParam \"foo\"@
    -- would return @Just "bar"@, but
    -- @queryParam \"zap\"@
    -- would return @Nothing@.
    queryParam :: T.Parseable a
               => S8.ByteString -- ^ Parameter name
               -> Controller s (Maybe a)
    queryParam :: ByteString -> Controller s (Maybe a)
    queryParam = ByteString -> Controller s (Maybe a)
    forall (m :: * -> *) a s.
    (Monad m, Parseable a) =>
    ByteString -> ControllerT s m (Maybe a)
    T.queryParam

    -- | Like 'queryParam', but throws an exception if the parameter is not present.
    queryParam' :: T.Parseable a
                => S.ByteString -> Controller s a
    queryParam' :: ByteString -> Controller s a
    queryParam' = ByteString -> Controller s a
    forall (m :: * -> *) a s.
    (Monad m, Parseable a) =>
    ByteString -> ControllerT s m a
    T.queryParam'

    -- | Selects all values with the given parameter name
    queryParams :: T.Parseable a
                => S.ByteString -> Controller s [a]
    queryParams :: ByteString -> Controller s [a]
    queryParams = ByteString -> Controller s [a]
    forall (m :: * -> *) a s.
    (Monad m, Parseable a) =>
    ByteString -> ControllerT s m [a]
    T.queryParams

    -- | Like 'queryParam', but further processes the parameter value with @read@.
    -- If that conversion fails, an exception is thrown.
    readQueryParam :: Read a
                   => S8.ByteString -- ^ Parameter name
                   -> Controller s (Maybe a)
    readQueryParam :: ByteString -> Controller s (Maybe a)
    readQueryParam = ByteString -> Controller s (Maybe a)
    forall (m :: * -> *) a s.
    (Monad m, Read a) =>
    ByteString -> ControllerT s m (Maybe a)
    T.readQueryParam

    -- | Like 'readQueryParam', but throws an exception if the parameter is not present.
    readQueryParam' :: Read a
                    => S8.ByteString -- ^ Parameter name
                    -> Controller s a
    readQueryParam' :: ByteString -> Controller s a
    readQueryParam' = ByteString -> Controller s a
    forall (m :: * -> *) a s.
    (Monad m, Read a) =>
    ByteString -> ControllerT s m a
    T.readQueryParam'

    -- | Like 'queryParams', but further processes the parameter values with @read@.
    -- If any read-conversion fails, an exception is thrown.
    readQueryParams :: Read a
                    => S8.ByteString -- ^ Parameter name
                    -> Controller s [a]
    readQueryParams :: ByteString -> Controller s [a]
    readQueryParams = ByteString -> Controller s [a]
    forall (m :: * -> *) a s.
    (Monad m, Read a) =>
    ByteString -> ControllerT s m [a]
    T.readQueryParams

    -- | Parses a HTML form from the request body. It returns a list of 'Param's as
    -- well as a list of 'File's, which are pairs mapping the name of a /file/ form
    -- field to a 'FileInfo' pointing to a temporary file with the contents of the
    -- upload.
    --
    -- @
    --   myControllerT = do
    --     (prms, files) <- parseForm
    --     let mPicFile = lookup \"profile_pic\" files
    --     case mPicFile of
    --       Just (picFile) -> do
    --         sourceFile (fileContent picFile) $$
    --           sinkFile (\"images/\" ++ (fileName picFile))
    --         respond $ redirectTo \"/\"
    --       Nothing -> redirectBack
    -- @
    parseForm :: Controller s ([Param], [(S.ByteString, FileInfo L.ByteString)])
    parseForm :: Controller s ([Param], [(ByteString, FileInfo ByteString)])
    parseForm = do
      Request
    req <- Controller s Request
    forall s. Controller s Request
    request
      IO ([Param], [(ByteString, FileInfo ByteString)])
    -> Controller s ([Param], [(ByteString, FileInfo ByteString)])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([Param], [(ByteString, FileInfo ByteString)])
     -> Controller s ([Param], [(ByteString, FileInfo ByteString)]))
    -> IO ([Param], [(ByteString, FileInfo ByteString)])
    -> Controller s ([Param], [(ByteString, FileInfo ByteString)])
    forall a b. (a -> b) -> a -> b
    $ BackEnd ByteString
    -> Request -> IO ([Param], [(ByteString, FileInfo ByteString)])
    forall y. BackEnd y -> Request -> IO ([Param], [File y])
    parseRequestBody BackEnd ByteString
    forall (m :: * -> *) ignored1 ignored2.
    Monad m =>
    ignored1 -> ignored2 -> m ByteString -> m ByteString
    lbsBackEnd Request
    req

    -- | Reads and returns the body of the HTTP request.
    body :: Controller s L8.ByteString
    body :: Controller s ByteString
    body = do
      IO ByteString
    bodyProducer <- Request -> IO ByteString
    getRequestBodyChunk (Request -> IO ByteString)
    -> ControllerT s IO Request -> ControllerT s IO (IO ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ControllerT s IO Request
    forall s. Controller s Request
    request
      IO ByteString -> Controller s ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> Controller s ByteString)
    -> IO ByteString -> Controller s ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        Builder
    result <- Builder -> IO ByteString -> IO Builder
    forall (m :: * -> *).
    Monad m =>
    Builder -> m ByteString -> m Builder
    consume Builder
    forall a. Monoid a => a
    mempty IO ByteString
    bodyProducer
        ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    toLazyByteString Builder
    result
      where consume :: Builder -> m ByteString -> m Builder
    consume bldr :: Builder
    bldr prod :: m ByteString
    prod = do
              ByteString
    next <- m ByteString
    prod
              if ByteString -> Bool
    S.null ByteString
    next then
                Builder -> m Builder
    forall (m :: * -> *) a. Monad m => a -> m a
    return Builder
    bldr
                else Builder -> m ByteString -> m Builder
    consume (Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    mappend Builder
    bldr (ByteString -> Builder
    fromByteString ByteString
    next)) m ByteString
    prod

    -- | Returns the value of the given request header or 'Nothing' if it is not
    -- present in the HTTP request.
    requestHeader :: HeaderName -> Controller s (Maybe S8.ByteString)
    requestHeader :: HeaderName -> Controller s (Maybe ByteString)
    requestHeader name :: HeaderName
    name = Controller s Request
    forall s. Controller s Request
    request Controller s Request
    -> (Request -> Controller s (Maybe ByteString))
    -> Controller s (Maybe ByteString)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe ByteString -> Controller s (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> Controller s (Maybe ByteString))
    -> (Request -> Maybe ByteString)
    -> Request
    -> Controller s (Maybe ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    name ([(HeaderName, ByteString)] -> Maybe ByteString)
    -> (Request -> [(HeaderName, ByteString)])
    -> Request
    -> Maybe ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> [(HeaderName, ByteString)]
    requestHeaders

    -- | Redirect back to the referer. If the referer header is not present
    -- redirect to root (i.e., @\/@).
    redirectBack :: Controller s a
    redirectBack :: Controller s a
    redirectBack = Response -> Controller s a
    forall s a. Response -> Controller s a
    redirectBackOr (ByteString -> Response
    redirectTo "/")

    -- | Redirect back to the referer. If the referer header is not present
    -- fallback on the given 'Response'.
    redirectBackOr :: Response -- ^ Fallback response
                   -> Controller s a
    redirectBackOr :: Response -> Controller s a
    redirectBackOr def :: Response
    def = do
      Maybe ByteString
    mrefr <- HeaderName -> Controller s (Maybe ByteString)
    forall s. HeaderName -> Controller s (Maybe ByteString)
    requestHeader "referer"
      case Maybe ByteString
    mrefr of
        Just refr :: ByteString
    refr -> Response -> Controller s a
    forall s a. Response -> Controller s a
    respond (Response -> Controller s a) -> Response -> Controller s a
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Response
    redirectTo ByteString
    refr
        Nothing   -> Response -> Controller s a
    forall s a. Response -> Controller s a
    respond Response
    def

    {- $Example
     #example#

    The most basic 'Routeable' types are 'Application' and 'Response'. Reaching
    either of these types marks a termination in the routing lookup. This module
    exposes a monadic type 'Route' which makes it easy to create routing logic
    in a DSL-like fashion.

    'Route's are concatenated using the '>>' operator (or using do-notation).
    In the end, any 'Routeable', including a 'Route' is converted to an
    'Application' and passed to the server using 'mkRoute':

    @

      mainAction :: Controller () ()
      mainAction = ...

      signinForm :: Controller () ()
      signinForm req = ...

      login :: Controller () ()
      login = ...

      updateProfile :: Controller () ()
      updateProfile = ...

      main :: IO ()
      main = run 3000 $ controllerApp () $ do
        routeTop mainAction
        routeName \"sessions\" $ do
          routeMethod GET signinForm
          routeMethod POST login
        routeMethod PUT $ routePattern \"users/:id\" updateProfile
        routeAll $ responseLBS status404 [] \"Are you in the right place?\"
    @

    -}