{-# LANGUAGE RecordWildCards #-}
module Web.Route.Invertible.URI
( requestURI
, uriRequest
, uriGETRequest
, routeActionURI
) where
import Control.Arrow ((&&&))
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Text as T
import Network.HTTP.Types.URI (parseSimpleQuery, renderSimpleQuery)
import Network.URI
import Web.Route.Invertible.Host
import Web.Route.Invertible.Method
import Web.Route.Invertible.Query
import Web.Route.Invertible.Request
import Web.Route.Invertible.Route
requestURI :: Request -> URI
requestURI :: Request -> URI
requestURI Request{Bool
[HostString]
[PathString]
HostString
QueryParams
Method
requestContentType :: Request -> HostString
requestQuery :: Request -> QueryParams
requestPath :: Request -> [PathString]
requestMethod :: Request -> Method
requestHost :: Request -> [HostString]
requestSecure :: Request -> Bool
requestContentType :: HostString
requestQuery :: QueryParams
requestPath :: [PathString]
requestMethod :: Method
requestHost :: [HostString]
requestSecure :: Bool
..} = URI
nullURI
{ uriScheme :: String
uriScheme = if Bool
requestSecure then String
"https:" else String
"http:"
, uriAuthority :: Maybe URIAuth
uriAuthority = if [HostString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HostString]
requestHost then Maybe URIAuth
forall a. Maybe a
Nothing else URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just URIAuth :: String -> String -> String -> URIAuth
URIAuth
{ uriUserInfo :: String
uriUserInfo = String
""
, uriRegName :: String
uriRegName = HostString -> String
BSC.unpack (HostString -> String) -> HostString -> String
forall a b. (a -> b) -> a -> b
$ [HostString] -> HostString
joinHost [HostString]
requestHost
, uriPort :: String
uriPort = String
""
}
, uriPath :: String
uriPath = (PathString -> String) -> [PathString] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((:) Char
'/' (String -> String)
-> (PathString -> String) -> PathString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isUnescapedInURIComponent (String -> String)
-> (PathString -> String) -> PathString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathString -> String
T.unpack) [PathString]
requestPath
, uriQuery :: String
uriQuery = HostString -> String
BSC.unpack (HostString -> String) -> HostString -> String
forall a b. (a -> b) -> a -> b
$ Bool -> SimpleQuery -> HostString
renderSimpleQuery Bool
True (SimpleQuery -> HostString) -> SimpleQuery -> HostString
forall a b. (a -> b) -> a -> b
$ QueryParams -> SimpleQuery
paramsQuerySimple QueryParams
requestQuery
}
uriRequest :: IsMethod m => m -> URI -> Request
uriRequest :: m -> URI -> Request
uriRequest m
m URI
u = Request :: Bool
-> [HostString]
-> Method
-> [PathString]
-> QueryParams
-> HostString
-> Request
Request
{ requestMethod :: Method
requestMethod = m -> Method
forall m. IsMethod m => m -> Method
toMethod m
m
, requestSecure :: Bool
requestSecure = URI -> String
uriScheme URI
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"https:"
, requestHost :: [HostString]
requestHost = [HostString]
-> (URIAuth -> [HostString]) -> Maybe URIAuth -> [HostString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HostString -> [HostString]
splitHost (HostString -> [HostString])
-> (URIAuth -> HostString) -> URIAuth -> [HostString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HostString
BSC.pack (String -> HostString)
-> (URIAuth -> String) -> URIAuth -> HostString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIAuth -> String
uriRegName) (Maybe URIAuth -> [HostString]) -> Maybe URIAuth -> [HostString]
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority URI
u
, requestPath :: [PathString]
requestPath = (String -> PathString) -> [String] -> [PathString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PathString
T.pack (String -> PathString)
-> (String -> String) -> String -> PathString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unEscapeString) ([String] -> [PathString]) -> [String] -> [PathString]
forall a b. (a -> b) -> a -> b
$ URI -> [String]
pathSegments URI
u
, requestQuery :: QueryParams
requestQuery = SimpleQuery -> QueryParams
simpleQueryParams (SimpleQuery -> QueryParams) -> SimpleQuery -> QueryParams
forall a b. (a -> b) -> a -> b
$ HostString -> SimpleQuery
parseSimpleQuery (HostString -> SimpleQuery) -> HostString -> SimpleQuery
forall a b. (a -> b) -> a -> b
$ String -> HostString
BSC.pack (String -> HostString) -> String -> HostString
forall a b. (a -> b) -> a -> b
$ URI -> String
uriQuery URI
u
, requestContentType :: HostString
requestContentType = HostString
forall a. Monoid a => a
mempty
}
uriGETRequest :: URI -> Request
uriGETRequest :: URI -> Request
uriGETRequest = Method -> URI -> Request
forall m. IsMethod m => m -> URI -> Request
uriRequest Method
GET
routeActionURI :: RouteAction r a -> r -> (Method, URI)
routeActionURI :: RouteAction r a -> r -> (Method, URI)
routeActionURI RouteAction r a
r = (Request -> Method
requestMethod (Request -> Method) -> (Request -> URI) -> Request -> (Method, URI)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Request -> URI
requestURI) (Request -> (Method, URI)) -> (r -> Request) -> r -> (Method, URI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteAction r a -> r -> Request
forall a b. RouteAction a b -> a -> Request
requestActionRoute RouteAction r a
r