{-# LANGUAGE RecordWildCards #-}
-- |
-- Conversion between "Network.URI" and routable representations such as 'Request'.
--
-- The most useful function here is 'routeActionURI' which performs reverse routing.
-- If you have an action already defined:
--
-- > getThing :: 'RouteAction' Int (IO Response)
--
-- Then @routeActionURI getThing 123@ will return the method and URI for that route, filling in the placeholders appropriately, e.g., @(GET, \"\/thing\/123\")@.
module Web.Route.Invertible.URI
  ( requestURI 
  , uriRequest
  , uriGETRequest
  , routeActionURI
  , boundRouteURI
  ) 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

-- |Convert a request to a URI, ignoring the method.
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
  }

-- |Convert a method and URI to a request.
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
  }

-- |Convert a GET URI to a request.
uriGETRequest :: URI -> Request
uriGETRequest :: URI -> Request
uriGETRequest = Method -> URI -> Request
forall m. IsMethod m => m -> URI -> Request
uriRequest Method
GET

-- |Reverse a route action to a URI.
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

-- |Reverse a bound route action to a URI.
boundRouteURI :: BoundRoute -> (Method, URI)
boundRouteURI :: BoundRoute -> (Method, URI)
boundRouteURI = (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))
-> (BoundRoute -> Request) -> BoundRoute -> (Method, URI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundRoute -> Request
requestBoundRoute