-- |A compatibility routing layer for WAI applications.
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

-- |Convert a 'Wai.Request' to a request.
waiRequest :: Wai.Request -> Request
waiRequest :: Request -> Request
waiRequest Request
q = Request :: Bool
-> [HostString]
-> Method
-> [PathString]
-> QueryParams
-> HostString
-> Request
Request
  { requestHost :: [HostString]
requestHost = [HostString]
-> (HostString -> [HostString]) -> Maybe HostString -> [HostString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HostString -> [HostString]
splitHost (Maybe HostString -> [HostString])
-> Maybe HostString -> [HostString]
forall a b. (a -> b) -> a -> b
$ Request -> Maybe HostString
Wai.requestHeaderHost Request
q
  , requestSecure :: Bool
requestSecure = Request -> Bool
Wai.isSecure Request
q
  , requestMethod :: Method
requestMethod = HostString -> Method
forall m. IsMethod m => m -> Method
toMethod (HostString -> Method) -> HostString -> Method
forall a b. (a -> b) -> a -> b
$ Request -> HostString
Wai.requestMethod Request
q
  , requestPath :: [PathString]
requestPath = Request -> [PathString]
Wai.pathInfo Request
q
  , requestQuery :: QueryParams
requestQuery = SimpleQuery -> QueryParams
simpleQueryParams (SimpleQuery -> QueryParams) -> SimpleQuery -> QueryParams
forall a b. (a -> b) -> a -> b
$ (QueryItem -> SimpleQueryItem) -> [QueryItem] -> SimpleQuery
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe HostString -> HostString) -> QueryItem -> SimpleQueryItem
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Maybe HostString -> HostString) -> QueryItem -> SimpleQueryItem)
-> (Maybe HostString -> HostString) -> QueryItem -> SimpleQueryItem
forall a b. (a -> b) -> a -> b
$ HostString -> Maybe HostString -> HostString
forall a. a -> Maybe a -> a
fromMaybe HostString
forall a. Monoid a => a
mempty) ([QueryItem] -> SimpleQuery) -> [QueryItem] -> SimpleQuery
forall a b. (a -> b) -> a -> b
$ Request -> [QueryItem]
Wai.queryString Request
q
  , requestContentType :: HostString
requestContentType = HostString -> Maybe HostString -> HostString
forall a. a -> Maybe a -> a
fromMaybe HostString
forall a. Monoid a => a
mempty (Maybe HostString -> HostString) -> Maybe HostString -> HostString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, HostString)] -> Maybe HostString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType [(HeaderName, HostString)]
headers
  } where headers :: [(HeaderName, HostString)]
headers = Request -> [(HeaderName, HostString)]
Wai.requestHeaders Request
q

-- |Lookup a wai request in a route map, returning either an error code and headers or a successful result.
routeWai :: Wai.Request -> RouteMap a -> Either (Status, ResponseHeaders) a
routeWai :: Request
-> RouteMap a -> Either (Status, [(HeaderName, HostString)]) a
routeWai = Request
-> RouteMap a -> Either (Status, [(HeaderName, HostString)]) a
forall a.
Request
-> RouteMap a -> Either (Status, [(HeaderName, HostString)]) a
routeRequest (Request
 -> RouteMap a -> Either (Status, [(HeaderName, HostString)]) a)
-> (Request -> Request)
-> Request
-> RouteMap a
-> Either (Status, [(HeaderName, HostString)]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
waiRequest

-- |Combine a set of applications in a routing map into a single application, calling a custom error handler in case of routing error.
routeWaiError :: (Status -> ResponseHeaders -> Wai.Request -> a) -> RouteMap (Wai.Request -> a) -> Wai.Request -> a
routeWaiError :: (Status -> [(HeaderName, HostString)] -> Request -> a)
-> RouteMap (Request -> a) -> Request -> a
routeWaiError Status -> [(HeaderName, HostString)] -> Request -> a
e RouteMap (Request -> a)
m Request
q = ((Status, [(HeaderName, HostString)]) -> a)
-> ((Request -> a) -> a)
-> Either (Status, [(HeaderName, HostString)]) (Request -> a)
-> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(Status
s, [(HeaderName, HostString)]
h) -> Status -> [(HeaderName, HostString)] -> Request -> a
e Status
s [(HeaderName, HostString)]
h Request
q) (\Request -> a
a -> Request -> a
a Request
q) (Either (Status, [(HeaderName, HostString)]) (Request -> a) -> a)
-> Either (Status, [(HeaderName, HostString)]) (Request -> a) -> a
forall a b. (a -> b) -> a -> b
$ Request
-> RouteMap (Request -> a)
-> Either (Status, [(HeaderName, HostString)]) (Request -> a)
forall a.
Request
-> RouteMap a -> Either (Status, [(HeaderName, HostString)]) a
routeWai Request
q RouteMap (Request -> a)
m

-- |Equivalent to 'routeWaiError'.
routeWaiApplicationError :: (Status -> ResponseHeaders -> Wai.Application) -> RouteMap Wai.Application -> Wai.Application
routeWaiApplicationError :: (Status -> [(HeaderName, HostString)] -> Application)
-> RouteMap Application -> Application
routeWaiApplicationError = (Status -> [(HeaderName, HostString)] -> Application)
-> RouteMap Application -> Application
forall a.
(Status -> [(HeaderName, HostString)] -> Request -> a)
-> RouteMap (Request -> a) -> Request -> a
routeWaiError

-- |Combine a set of applications in a routing map into a single application, returning an empty error response in case of routing error.
routeWaiApplication :: RouteMap Wai.Application -> Wai.Application
routeWaiApplication :: RouteMap Application -> Application
routeWaiApplication = (Status -> [(HeaderName, HostString)] -> Application)
-> RouteMap Application -> Application
routeWaiApplicationError ((Status -> [(HeaderName, HostString)] -> Application)
 -> RouteMap Application -> Application)
-> (Status -> [(HeaderName, HostString)] -> Application)
-> RouteMap Application
-> Application
forall a b. (a -> b) -> a -> b
$ \Status
s [(HeaderName, HostString)]
h Request
_ Response -> IO ResponseReceived
r -> Response -> IO ResponseReceived
r (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> [(HeaderName, HostString)] -> Builder -> Response
Wai.responseBuilder Status
s [(HeaderName, HostString)]
h Builder
forall a. Monoid a => a
mempty