{-# 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
[PathString]
[HostString]
HostString
QueryParams
Method
requestSecure :: Bool
requestHost :: [HostString]
requestMethod :: Method
requestPath :: [PathString]
requestQuery :: QueryParams
requestContentType :: HostString
requestContentType :: Request -> HostString
requestQuery :: Request -> QueryParams
requestPath :: Request -> [PathString]
requestMethod :: Request -> Method
requestHost :: Request -> [HostString]
requestSecure :: Request -> Bool
..} = URI
nullURI
  { uriScheme = if requestSecure then "https:" else "http:"
  , uriAuthority = if null requestHost then Nothing else Just URIAuth
    { uriUserInfo = ""
    , uriRegName = BSC.unpack $ joinHost requestHost
    , uriPort = ""
    }
  , uriPath = concatMap ((:) '/' . escapeURIString isUnescapedInURIComponent . T.unpack) requestPath
  , uriQuery = BSC.unpack $ renderSimpleQuery True $ paramsQuerySimple requestQuery
  }

-- |Convert a method and URI to a request.
uriRequest :: IsMethod m => m -> URI -> Request
uriRequest :: forall m. IsMethod m => m -> URI -> Request
uriRequest m
m URI
u = 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 :: forall r a. RouteAction r a -> r -> (Method, URI)
routeActionURI RouteAction r a
r = (Request -> Method
requestMethod (Request -> Method) -> (Request -> URI) -> Request -> (Method, URI)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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