module Web.Route.Invertible.Wai
( module Web.Route.Invertible.Common
, waiRequest
, routeWai
, routeWaiError
, routeWaiApplicationError
, routeWaiApplication
) where
import Control.Arrow (second)
import Data.Maybe (fromMaybe)
import qualified Network.Wai as Wai
import Network.HTTP.Types.Header (ResponseHeaders, hContentType)
import Network.HTTP.Types.Status (Status)
import Web.Route.Invertible.Internal
import Web.Route.Invertible.Common
import Web.Route.Invertible
waiRequest :: Wai.Request -> Request
waiRequest q = Request
{ requestHost = maybe [] splitHost $ Wai.requestHeaderHost q
, requestSecure = Wai.isSecure q
, requestMethod = toMethod $ Wai.requestMethod q
, requestPath = Wai.pathInfo q
, requestQuery = simpleQueryParams $ map (second $ fromMaybe mempty) $ Wai.queryString q
, requestContentType = fromMaybe mempty $ lookup hContentType headers
} where headers = Wai.requestHeaders q
routeWai :: Wai.Request -> RouteMap a -> Either (Status, ResponseHeaders) a
routeWai = routeRequest . waiRequest
routeWaiError :: (Status -> ResponseHeaders -> Wai.Request -> a) -> RouteMap (Wai.Request -> a) -> Wai.Request -> a
routeWaiError e m q = either (\(s, h) -> e s h q) (\a -> a q) $ routeWai q m
routeWaiApplicationError :: (Status -> ResponseHeaders -> Wai.Application) -> RouteMap Wai.Application -> Wai.Application
routeWaiApplicationError = routeWaiError
routeWaiApplication :: RouteMap Wai.Application -> Wai.Application
routeWaiApplication = routeWaiApplicationError $ \s h _ r -> r $ Wai.responseBuilder s h mempty