module IHP.Controller.Response
( respondAndExit
, addResponseHeaders
, addResponseHeadersFromContext
, ResponseException (..)
)
where

import ClassyPrelude
import Network.HTTP.Types.Header
import qualified IHP.Controller.Context as Context
import IHP.Controller.Context (ControllerContext(ControllerContext))
import qualified Network.Wai
import Network.Wai (Response)
import qualified Control.Exception as Exception

respondAndExit :: (?context::ControllerContext) => Response -> IO ()
respondAndExit :: (?context::ControllerContext) => Response -> IO ()
respondAndExit Response
response = do
    Response
responseWithHeaders <- (?context::ControllerContext) => Response -> IO Response
Response -> IO Response
addResponseHeadersFromContext Response
response
    ResponseException -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Response -> ResponseException
ResponseException Response
responseWithHeaders)
{-# INLINE respondAndExit #-}

-- | Add headers to current response
-- | Returns a Response with headers
--
-- > addResponseHeaders [("Content-Type", "text/html")] response
--
addResponseHeaders :: [Header] -> Response -> Response
addResponseHeaders :: ResponseHeaders -> Response -> Response
addResponseHeaders ResponseHeaders
headers = (ResponseHeaders -> ResponseHeaders) -> Response -> Response
Network.Wai.mapResponseHeaders (\ResponseHeaders
hs -> ResponseHeaders
headers ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. Semigroup a => a -> a -> a
<> ResponseHeaders
hs)
{-# INLINABLE addResponseHeaders #-}

-- | Add headers to current response, getting the headers from ControllerContext
-- | Returns a Response with headers
--
-- > addResponseHeadersFromContext response
-- You probabaly want `setHeader`
--
addResponseHeadersFromContext :: (?context :: ControllerContext) => Response -> IO Response
addResponseHeadersFromContext :: (?context::ControllerContext) => Response -> IO Response
addResponseHeadersFromContext Response
response = do
    Maybe ResponseHeaders
maybeHeaders <- forall value.
(?context::ControllerContext, Typeable value) =>
IO (Maybe value)
Context.maybeFromContext @[Header]
    let headers :: ResponseHeaders
headers = ResponseHeaders -> Maybe ResponseHeaders -> ResponseHeaders
forall a. a -> Maybe a -> a
fromMaybe [] Maybe ResponseHeaders
maybeHeaders
    let responseWithHeaders :: Response
responseWithHeaders = ResponseHeaders -> Response -> Response
addResponseHeaders ResponseHeaders
headers Response
response
    Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
responseWithHeaders
{-# INLINABLE addResponseHeadersFromContext #-}

-- Can be thrown from inside the action to abort the current action execution.
-- Does not indicates a runtime error. It's just used for control flow management.
newtype ResponseException = ResponseException Response

instance Show ResponseException where show :: ResponseException -> String
show ResponseException
_ = String
"ResponseException { .. }"

instance Exception ResponseException