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 :: 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
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
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
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
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