-- |Single-route construction.
-- This package lets you describe the individual end-points for routing and their associated values, essentially packaging up 'Host', 'Path', 'Method' and others with a value ('Action') to represent an entry in your routing table.
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable, RankNTypes, TypeOperators, QuasiQuotes #-}
module Web.Route.Invertible.Route
  ( RoutePredicate(..)
  , Route(..)
  , routeHost
  , routeSecure
  , routePath
  , routeMethod
  , routeMethods
  , routeQuery
  , routeAccept
  , routeAccepts
  , routeCustom
  , routeFilter
  , routePriority
  , normRoute
  , foldRoute
  , requestRoutePredicate
  , requestRoute'
  , requestRoute
  , BoundRoute(..)
  , requestBoundRoute
  , RouteAction(..)
  , mapActionRoute
  , requestActionRoute
  , (!:?)
  ) where

import Control.Invertible.Monoidal
import Control.Invertible.Monoidal.Free
import Control.Monad (guard)
import qualified Data.HashMap.Lazy as HM
import qualified Data.Invertible as I
import Data.Monoid (Endo(..))
import Data.Typeable (Typeable)

import Web.Route.Invertible.Placeholder
import Web.Route.Invertible.Sequence
import Web.Route.Invertible.Host
import Web.Route.Invertible.Method
import Web.Route.Invertible.Path
import Web.Route.Invertible.Query
import Web.Route.Invertible.ContentType
import Web.Route.Invertible.Request

-- |A term, qualifier, or component of a route, each specifying one filter/attribute/parser/generator for a request.
data RoutePredicate a where
  RouteHost     :: !(Host h) -> RoutePredicate h
  RouteSecure   :: !Bool     -> RoutePredicate ()
  RoutePath     :: !(Path p) -> RoutePredicate p
  RouteMethod   :: !Method   -> RoutePredicate ()
  RouteQuery    :: !QueryString -> !(Placeholder QueryString a) -> RoutePredicate a
  RouteAccept   :: !ContentType -> RoutePredicate ()
  RouteCustom   :: Typeable a => (Request -> Maybe a) -> (a -> Request -> Request) -> RoutePredicate a
  RoutePriority :: !Int      -> RoutePredicate ()

instance Show (RoutePredicate a) where
  showsPrec :: Int -> RoutePredicate a -> ShowS
showsPrec Int
d (RouteHost Host a
h) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteHost " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Host a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Host a
h
  showsPrec Int
d (RouteSecure Bool
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteSecure " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
s
  showsPrec Int
d (RoutePath Path a
p) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RoutePath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Path a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Path a
p
  showsPrec Int
d (RouteMethod Method
m) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteMethod " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Method -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Method
m
  showsPrec Int
d (RouteQuery ContentType
q Placeholder ContentType a
p) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteQuery " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ContentType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ContentType
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Placeholder ContentType a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Placeholder ContentType a
p
  showsPrec Int
d (RouteAccept ContentType
t) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteAccept " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ContentType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ContentType
t
  showsPrec Int
d (RouteCustom Request -> Maybe a
_ a -> Request -> Request
_) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RouteCustom <function> <function>"
  showsPrec Int
d (RoutePriority Int
p) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"RoutePriority " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
p

-- |A 'Monoidal' collection of routing predicates.
-- For example:
--
-- > routeHost ("www" >* "domain.com") *< routePath ("object" *< parameter) :: Route Int
newtype Route a = Route { forall a. Route a -> Free RoutePredicate a
freeRoute :: Free RoutePredicate a }
  deriving ((forall a b. (a <-> b) -> Route a -> Route b) -> Functor Route
forall a b. (a <-> b) -> Route a -> Route b
forall (f :: * -> *).
(forall a b. (a <-> b) -> f a -> f b) -> Functor f
$cfmap :: forall a b. (a <-> b) -> Route a -> Route b
fmap :: forall a b. (a <-> b) -> Route a -> Route b
I.Functor, Functor Route
Route ()
Functor Route =>
Route ()
-> (forall a b. Route a -> Route b -> Route (a, b))
-> Monoidal Route
forall a b. Route a -> Route b -> Route (a, b)
forall (f :: * -> *).
Functor f =>
f () -> (forall a b. f a -> f b -> f (a, b)) -> Monoidal f
$cunit :: Route ()
unit :: Route ()
$c>*< :: forall a b. Route a -> Route b -> Route (a, b)
>*< :: forall a b. Route a -> Route b -> Route (a, b)
Monoidal, Monoidal Route
Route Void
Monoidal Route =>
Route Void
-> (forall a b. Route a -> Route b -> Route (Either a b))
-> MonoidalAlt Route
forall a b. Route a -> Route b -> Route (Either a b)
forall (f :: * -> *).
Monoidal f =>
f Void
-> (forall a b. f a -> f b -> f (Either a b)) -> MonoidalAlt f
$czero :: Route Void
zero :: Route Void
$c>|< :: forall a b. Route a -> Route b -> Route (Either a b)
>|< :: forall a b. Route a -> Route b -> Route (Either a b)
MonoidalAlt)

instance Show (Route a) where
  showsPrec :: Int -> Route a -> ShowS
showsPrec Int
d (Route Free RoutePredicate a
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Route " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a'. RoutePredicate a' -> ShowS)
-> Free RoutePredicate a -> ShowS
forall (f :: * -> *) a.
(forall a'. f a' -> ShowS) -> Free f a -> ShowS
showsFree (Int -> RoutePredicate a' -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11) Free RoutePredicate a
s

-- |Limit a route to matching hosts.
-- By default, routes apply to any hosts not matched by any other routes in the map.
-- When combining (with 'Web.Route.Invertible.Map.Route.routes') or normalizing (with 'normRoute') routes, this has the highest precedence.
routeHost :: Host h -> Route h
routeHost :: forall h. Host h -> Route h
routeHost = Free RoutePredicate h -> Route h
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate h -> Route h)
-> (Host h -> Free RoutePredicate h) -> Host h -> Route h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate h -> Free RoutePredicate h
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate h -> Free RoutePredicate h)
-> (Host h -> RoutePredicate h) -> Host h -> Free RoutePredicate h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host h -> RoutePredicate h
forall h. Host h -> RoutePredicate h
RouteHost

-- |Limit a route to only secure (https:) or insecure (http:) protocols.
-- By default, routes apply to both.
routeSecure :: Bool -> Route ()
routeSecure :: Bool -> Route ()
routeSecure = Free RoutePredicate () -> Route ()
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate () -> Route ())
-> (Bool -> Free RoutePredicate ()) -> Bool -> Route ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate () -> Free RoutePredicate ()
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate () -> Free RoutePredicate ())
-> (Bool -> RoutePredicate ()) -> Bool -> Free RoutePredicate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RoutePredicate ()
RouteSecure

-- |Limit a route to matching paths.
-- By default, routes apply to any paths not matched by any other routes in the map (e.g., 404 handler, though it can be more general to handle a 'Web.Route.Invertible.Result.RouteNotFound' result directly) that also match all previous predicates. 
routePath :: Path p -> Route p
routePath :: forall p. Path p -> Route p
routePath = Free RoutePredicate p -> Route p
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate p -> Route p)
-> (Path p -> Free RoutePredicate p) -> Path p -> Route p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate p -> Free RoutePredicate p
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate p -> Free RoutePredicate p)
-> (Path p -> RoutePredicate p) -> Path p -> Free RoutePredicate p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path p -> RoutePredicate p
forall p. Path p -> RoutePredicate p
RoutePath

-- |Limit a route to a method.
-- By default, routes apply to all methods not handled by any other routes for the same earlier matching predicates (e.g., within the same path).
routeMethod :: IsMethod m => m -> Route ()
routeMethod :: forall m. IsMethod m => m -> Route ()
routeMethod = Free RoutePredicate () -> Route ()
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate () -> Route ())
-> (m -> Free RoutePredicate ()) -> m -> Route ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate () -> Free RoutePredicate ()
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate () -> Free RoutePredicate ())
-> (m -> RoutePredicate ()) -> m -> Free RoutePredicate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> RoutePredicate ()
RouteMethod (Method -> RoutePredicate ())
-> (m -> Method) -> m -> RoutePredicate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> Method
forall m. IsMethod m => m -> Method
toMethod

-- |Limit a route to a list of methods and return that method.
-- Supplying a method not in this list when generating (reverse) routes will result in a run-time error.
routeMethods :: (Eq m, IsMethod m) => [m] -> Route m
routeMethods :: forall m. (Eq m, IsMethod m) => [m] -> Route m
routeMethods = (m -> Route ()) -> [m] -> Route m
forall (f :: * -> *) a.
(MonoidalAlt f, Eq a) =>
(a -> f ()) -> [a] -> f a
oneOfI m -> Route ()
forall m. IsMethod m => m -> Route ()
routeMethod

-- |Limit a route to requests with a matching URL query parameter.
-- By default, other routes match only when the given parameter is missing.
routeQuery :: QueryString -> Placeholder QueryString a -> Route a
routeQuery :: forall a. ContentType -> Placeholder ContentType a -> Route a
routeQuery ContentType
q = Free RoutePredicate a -> Route a
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate a -> Route a)
-> (Placeholder ContentType a -> Free RoutePredicate a)
-> Placeholder ContentType a
-> Route a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate a -> Free RoutePredicate a
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate a -> Free RoutePredicate a)
-> (Placeholder ContentType a -> RoutePredicate a)
-> Placeholder ContentType a
-> Free RoutePredicate a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> Placeholder ContentType a -> RoutePredicate a
forall a.
ContentType -> Placeholder ContentType a -> RoutePredicate a
RouteQuery ContentType
q

-- |Limit a route to requests with the given \"Content-type\" header, i.e., POST requests containing a request body of a certain type.
-- Note that this does not relate to the type of the response or the \"Accept\" header.
-- By default, routes match only requests without bodies or with content-type headers not matched by any other routes.
routeAccept :: ContentType -> Route ()
routeAccept :: ContentType -> Route ()
routeAccept = Free RoutePredicate () -> Route ()
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate () -> Route ())
-> (ContentType -> Free RoutePredicate ())
-> ContentType
-> Route ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate () -> Free RoutePredicate ()
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate () -> Free RoutePredicate ())
-> (ContentType -> RoutePredicate ())
-> ContentType
-> Free RoutePredicate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> RoutePredicate ()
RouteAccept

-- |Limit a route to a list of methods and return that method.
-- Supplying a method not in this list when generating (reverse) routes will result in a run-time error.
routeAccepts :: [ContentType] -> Route ContentType
routeAccepts :: [ContentType] -> Route ContentType
routeAccepts = (ContentType -> Route ()) -> [ContentType] -> Route ContentType
forall (f :: * -> *) a.
(MonoidalAlt f, Eq a) =>
(a -> f ()) -> [a] -> f a
oneOfI ContentType -> Route ()
routeAccept

-- |A custom routing predicate that can perform arbitrary tests on the request and reverse routing.
-- The first argument is used in forward routing to check the request, and only passes if it returns 'Just'.
-- The second argument is used in reverse routing to modify the request according to the parameter.
-- By default, routes match all requests -- unlike other predicates, matching a custom rule does not exclude other routes.
-- This should be used sparingly and towards the end of a route as, unlike most other predicates, it only provides /O(n)/ lookups, as these functions must be called for every route candidate (those where all previous predicates match).
routeCustom :: Typeable a => (Request -> Maybe a) -> (a -> Request -> Request) -> Route a
routeCustom :: forall a.
Typeable a =>
(Request -> Maybe a) -> (a -> Request -> Request) -> Route a
routeCustom Request -> Maybe a
fwd a -> Request -> Request
rev = Free RoutePredicate a -> Route a
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate a -> Route a)
-> Free RoutePredicate a -> Route a
forall a b. (a -> b) -> a -> b
$ RoutePredicate a -> Free RoutePredicate a
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate a -> Free RoutePredicate a)
-> RoutePredicate a -> Free RoutePredicate a
forall a b. (a -> b) -> a -> b
$ (Request -> Maybe a)
-> (a -> Request -> Request) -> RoutePredicate a
forall a.
Typeable a =>
(Request -> Maybe a)
-> (a -> Request -> Request) -> RoutePredicate a
RouteCustom Request -> Maybe a
fwd a -> Request -> Request
rev

-- |A simpler version of 'routeCustom' that just takes a filter function to check again the request.
routeFilter :: (Request -> Bool) -> Route ()
routeFilter :: (Request -> Bool) -> Route ()
routeFilter Request -> Bool
f = (Request -> Maybe ()) -> (() -> Request -> Request) -> Route ()
forall a.
Typeable a =>
(Request -> Maybe a) -> (a -> Request -> Request) -> Route a
routeCustom (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Request -> Bool) -> Request -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Bool
f) (\() -> Request -> Request
forall a. a -> a
id)

-- |Set the priority of a route.  Routes with higher priority take precedence when there is a conflict.
-- By default, routes have priority 0.
-- When combining (with 'Web.Route.Invertible.Map.Route.routes') or normalizing (with 'normRoute') routes, this has the lowest precedence (so that conflicts are handled only after matching all other predicates).
routePriority :: Int -> Route ()
routePriority :: Int -> Route ()
routePriority = Free RoutePredicate () -> Route ()
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate () -> Route ())
-> (Int -> Free RoutePredicate ()) -> Int -> Route ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate () -> Free RoutePredicate ()
forall (f :: * -> *) a. f a -> Free f a
Free (RoutePredicate () -> Free RoutePredicate ())
-> (Int -> RoutePredicate ()) -> Int -> Free RoutePredicate ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RoutePredicate ()
RoutePriority

predicateOrder :: RoutePredicate a -> Int
predicateOrder :: forall a. RoutePredicate a -> Int
predicateOrder (RouteHost     Host a
_) = Int
1
predicateOrder (RouteSecure   Bool
_) = Int
2
predicateOrder (RoutePath     Path a
_) = Int
3
predicateOrder (RouteMethod   Method
_) = Int
4
predicateOrder (RouteQuery ContentType
_  Placeholder ContentType a
_) = Int
5
predicateOrder (RouteAccept   ContentType
_) = Int
6
predicateOrder (RouteCustom Request -> Maybe a
_ a -> Request -> Request
_) = Int
7
predicateOrder (RoutePriority Int
_) = Int
8

comparePredicate :: RoutePredicate a -> RoutePredicate b -> Ordering
comparePredicate :: forall a b. RoutePredicate a -> RoutePredicate b -> Ordering
comparePredicate (RouteQuery ContentType
p Placeholder ContentType a
_) (RouteQuery ContentType
q Placeholder ContentType b
_) = ContentType -> ContentType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ContentType
p ContentType
q
comparePredicate RoutePredicate a
p RoutePredicate b
q = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RoutePredicate a -> Int
forall a. RoutePredicate a -> Int
predicateOrder RoutePredicate a
p) (RoutePredicate b -> Int
forall a. RoutePredicate a -> Int
predicateOrder RoutePredicate b
q)

-- |By default, route predicates are matched in the order they are specified, so each test is done only if all preceding tests succeed.
-- However, in most cases routing rules should be tested in a specific order in order to produce sensible errors (e.g., a 405 error that offers available methods should only apply to other routes with the same path).
-- This re-orders the predicates in a route in order of the constructors in 'RoutePredicate' (i.e., host, secure, path, method, ...), allowing you to construct your routes in any order but still produce sensible matching behavior.
-- Alternatively, since there are cases you may watch to match in a different order (e.g., for 'routePriority'), you can specify your routes in specific order and avoid this function (which would also be more efficient).
-- Note that there are some \"de-normalized\" cases that this will not correct, such as having duplicate 'routeMethod' specifications (in which case all must match, but each is done independently).
normRoute :: Route a -> Route a
normRoute :: forall a. Route a -> Route a
normRoute = Free RoutePredicate a -> Route a
forall a. Free RoutePredicate a -> Route a
Route (Free RoutePredicate a -> Route a)
-> (Route a -> Free RoutePredicate a) -> Route a -> Route a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. RoutePredicate a -> RoutePredicate b -> Ordering)
-> Free RoutePredicate a -> Free RoutePredicate a
forall (f :: * -> *) a.
(forall a' b'. f a' -> f b' -> Ordering) -> Free f a -> Free f a
sortFreeTDNF RoutePredicate a' -> RoutePredicate b' -> Ordering
forall a b. RoutePredicate a -> RoutePredicate b -> Ordering
comparePredicate (Free RoutePredicate a -> Free RoutePredicate a)
-> (Route a -> Free RoutePredicate a)
-> Route a
-> Free RoutePredicate a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route a -> Free RoutePredicate a
forall a. Route a -> Free RoutePredicate a
freeRoute

-- |Fold over the predicates in an instatiated route.
foldRoute :: Monoid b => (forall a' . RoutePredicate a' -> a' -> b) -> Route a -> a -> b
foldRoute :: forall b a.
Monoid b =>
(forall a'. RoutePredicate a' -> a' -> b) -> Route a -> a -> b
foldRoute forall a'. RoutePredicate a' -> a' -> b
f (Route Free RoutePredicate a
r) = (forall a'. RoutePredicate a' -> a' -> b)
-> Free RoutePredicate a -> a -> b
forall b (f :: * -> *) a.
Monoid b =>
(forall a'. f a' -> a' -> b) -> Free f a -> a -> b
foldFree RoutePredicate a' -> a' -> b
forall a'. RoutePredicate a' -> a' -> b
f Free RoutePredicate a
r

requestRoutePredicate :: RoutePredicate a -> a -> Request -> Request
requestRoutePredicate :: forall a. RoutePredicate a -> a -> Request -> Request
requestRoutePredicate (RouteHost (HostRev Sequence ContentType a
s)) a
h Request
q = Request
q{ requestHost = renderSequence s h }
requestRoutePredicate (RouteSecure Bool
s)        () Request
q = Request
q{ requestSecure = s }
requestRoutePredicate (RoutePath (Path Sequence PathString a
s))    a
p Request
q = Request
q{ requestPath = renderSequence s p }
requestRoutePredicate (RouteMethod Method
m)        () Request
q = Request
q{ requestMethod = m }
requestRoutePredicate (RouteQuery ContentType
n Placeholder ContentType a
p)        a
v Request
q = Request
q{ requestQuery = HM.insertWith (++) n [renderPlaceholder p v] $ requestQuery q }
requestRoutePredicate (RouteAccept ContentType
t)        () Request
q = Request
q{ requestContentType = t }
requestRoutePredicate (RouteCustom Request -> Maybe a
_ a -> Request -> Request
f)       a
a Request
q = a -> Request -> Request
f a
a Request
q
requestRoutePredicate (RoutePriority Int
_)      () Request
q = Request
q

-- |Given an instantiation of a 'Route' with its value, add the relevant reverse-route information to a 'Request'.
requestRoute' :: Route a -> a -> Request -> Request
requestRoute' :: forall a. Route a -> a -> Request -> Request
requestRoute' Route a
r = Endo Request -> Request -> Request
forall a. Endo a -> a -> a
appEndo (Endo Request -> Request -> Request)
-> (a -> Endo Request) -> a -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a'. RoutePredicate a' -> a' -> Endo Request)
-> Route a -> a -> Endo Request
forall b a.
Monoid b =>
(forall a'. RoutePredicate a' -> a' -> b) -> Route a -> a -> b
foldRoute (\RoutePredicate a'
p -> (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (a' -> Request -> Request) -> a' -> Endo Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoutePredicate a' -> a' -> Request -> Request
forall a. RoutePredicate a -> a -> Request -> Request
requestRoutePredicate RoutePredicate a'
p) Route a
r

-- |Apply 'requestRoute'' to 'blankRequest'.
requestRoute :: Route a -> a -> Request
requestRoute :: forall a. Route a -> a -> Request
requestRoute Route a
r a
a = Route a -> a -> Request -> Request
forall a. Route a -> a -> Request -> Request
requestRoute' Route a
r a
a Request
blankRequest

-- |A route bound with its parameter.  Useful for passing concerete specific routes without type variables.
data BoundRoute = forall a. Route a :? a

infix 1 :?

-- |Apply 'requestRoute' on a 'BoundRoute'.
requestBoundRoute :: BoundRoute -> Request
requestBoundRoute :: BoundRoute -> Request
requestBoundRoute (Route a
r :? a
a) = Route a -> a -> Request
forall a. Route a -> a -> Request
requestRoute Route a
r a
a

-- |Specify the action to take for a given route, often used as an infix operator between the route specification and the function used to produce the result (which usually generates the HTTP response, but could be anything).
data RouteAction a b = RouteAction
  { forall a b. RouteAction a b -> Route a
actionRoute :: !(Route a)
  , forall a b. RouteAction a b -> a -> b
routeAction :: !(a -> b)
  }

infix 1 `RouteAction`

instance Functor (RouteAction a) where
  fmap :: forall a b. (a -> b) -> RouteAction a a -> RouteAction a b
fmap a -> b
f (RouteAction Route a
r a -> a
a) = Route a -> (a -> b) -> RouteAction a b
forall a b. Route a -> (a -> b) -> RouteAction a b
RouteAction Route a
r ((a -> b) -> RouteAction a b) -> (a -> b) -> RouteAction a b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
a

-- |'RouteAction' is invariant in its first argument.
-- Apply a bijection to the routing argument, leaving the action alone.
mapActionRoute :: (a I.<-> b) -> RouteAction a r -> RouteAction b r
mapActionRoute :: forall a b r. (a <-> b) -> RouteAction a r -> RouteAction b r
mapActionRoute a <-> b
f (RouteAction Route a
r a -> r
a) = Route b -> (b -> r) -> RouteAction b r
forall a b. Route a -> (a -> b) -> RouteAction a b
RouteAction (a <-> b
f (a <-> b) -> Route a -> Route b
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< Route a
r) (a -> r
a (a -> r) -> (b -> a) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a <-> b) -> b -> a
forall (a :: * -> * -> *) b c. Bijection a b c -> a c b
I.biFrom a <-> b
f)

-- |Apply 'requestRoute' to 'actionRoute'.
requestActionRoute :: RouteAction a b -> a -> Request
requestActionRoute :: forall a b. RouteAction a b -> a -> Request
requestActionRoute = Route a -> a -> Request
forall a. Route a -> a -> Request
requestRoute (Route a -> a -> Request)
-> (RouteAction a b -> Route a) -> RouteAction a b -> a -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteAction a b -> Route a
forall a b. RouteAction a b -> Route a
actionRoute

-- |Combine '(:?)' and 'actionRoute'.
(!:?) :: RouteAction a b -> a -> BoundRoute
!:? :: forall a b. RouteAction a b -> a -> BoundRoute
(!:?) = Route a -> a -> BoundRoute
forall a. Route a -> a -> BoundRoute
(:?) (Route a -> a -> BoundRoute)
-> (RouteAction a b -> Route a)
-> RouteAction a b
-> a
-> BoundRoute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RouteAction a b -> Route a
forall a b. RouteAction a b -> Route a
actionRoute

infix 1 !:?