-- |Routing tables.
-- Once you have a number of endpoints defined, you can create a routing table of them using 'routeCase' and 'routes', dynamically combining the various Map representations as necessary to create a single, efficient map.
{-# LANGUAGE DeriveFunctor, RecordWildCards, GADTs, Rank2Types, TupleSections #-}
module Web.Route.Invertible.Map.Route
  ( RouteCase
  , RouteMap
  , routeCase
  , routeNormCase
  , routes
  , fallbackHEADtoGET
  , lookupRoute
  ) where

import Prelude hiding (lookup)

import Control.Applicative (Alternative(..))
import Control.Invertible.Monoidal.Free
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.State (evalState)
import Data.Dynamic (Dynamic, toDyn)
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as Map

import Web.Route.Invertible.String
import Web.Route.Invertible.Sequence
import Web.Route.Invertible.Path
import Web.Route.Invertible.Host
import Web.Route.Invertible.ContentType
import Web.Route.Invertible.Dynamics
import Web.Route.Invertible.Route
import Web.Route.Invertible.Request
import Web.Route.Invertible.Result
import Web.Route.Invertible.Monoid.Exactly
import Web.Route.Invertible.Monoid.Prioritized
import Web.Route.Invertible.Map.Monoid
import Web.Route.Invertible.Map.MonoidHash
import Web.Route.Invertible.Map.Default
import Web.Route.Invertible.Map.Const
import Web.Route.Invertible.Map.Bool
import Web.Route.Invertible.Map.Sequence
import Web.Route.Invertible.Map.Path
import Web.Route.Invertible.Map.Host
import Web.Route.Invertible.Map.Method
import Web.Route.Invertible.Map.Query
import Web.Route.Invertible.Map.Custom

-- |A routing table mapping 'Request's to values (actions) @a@.
data RouteMapT m a
  -- These constructors are expected to be nested in order for normalized routes
  = RouteMapHost      !(DefaultMap HostMap (RouteMapT m a))
  | RouteMapSecure    !(BoolMap (RouteMapT m a))
  | RouteMapPath      !(DefaultMap PathMap (RouteMapT m a))
  | RouteMapMethod    !(DefaultMap MethodMap (RouteMapT m a))
  | RouteMapQuery     !(QueryMap (RouteMapT m a))
  | RouteMapAccept    !(DefaultMap (MonoidHashMap ContentType) (RouteMapT m a))
  | RouteMapCustom    !(ConstMap (CustomMap Request Dynamic) (RouteMapT m a))
  | RouteMapPriority  !(Prioritized (RouteMapT m a))
  | RouteMapExactly   !(Exactly (m a))
  deriving (Int -> RouteMapT m a -> ShowS
[RouteMapT m a] -> ShowS
RouteMapT m a -> String
(Int -> RouteMapT m a -> ShowS)
-> (RouteMapT m a -> String)
-> ([RouteMapT m a] -> ShowS)
-> Show (RouteMapT m a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) a. Show (m a) => Int -> RouteMapT m a -> ShowS
forall (m :: * -> *) a. Show (m a) => [RouteMapT m a] -> ShowS
forall (m :: * -> *) a. Show (m a) => RouteMapT m a -> String
showList :: [RouteMapT m a] -> ShowS
$cshowList :: forall (m :: * -> *) a. Show (m a) => [RouteMapT m a] -> ShowS
show :: RouteMapT m a -> String
$cshow :: forall (m :: * -> *) a. Show (m a) => RouteMapT m a -> String
showsPrec :: Int -> RouteMapT m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a. Show (m a) => Int -> RouteMapT m a -> ShowS
Show)

instance Semigroup (RouteMapT m a) where
  RouteMapT m a
m <> :: RouteMapT m a -> RouteMapT m a -> RouteMapT m a
<> RouteMapExactly Exactly (m a)
Blank = RouteMapT m a
m
  RouteMapExactly Exactly (m a)
Blank <> RouteMapT m a
m = RouteMapT m a
m
  RouteMapHost     DefaultMap HostMap (RouteMapT m a)
a <> RouteMapHost     DefaultMap HostMap (RouteMapT m a)
b = DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
RouteMapHost     (DefaultMap HostMap (RouteMapT m a)
a DefaultMap HostMap (RouteMapT m a)
-> DefaultMap HostMap (RouteMapT m a)
-> DefaultMap HostMap (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> DefaultMap HostMap (RouteMapT m a)
b)
  RouteMapSecure   BoolMap (RouteMapT m a)
a <> RouteMapSecure   BoolMap (RouteMapT m a)
b = BoolMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. BoolMap (RouteMapT m a) -> RouteMapT m a
RouteMapSecure   (BoolMap (RouteMapT m a)
a BoolMap (RouteMapT m a)
-> BoolMap (RouteMapT m a) -> BoolMap (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> BoolMap (RouteMapT m a)
b)
  RouteMapPath     DefaultMap PathMap (RouteMapT m a)
a <> RouteMapPath     DefaultMap PathMap (RouteMapT m a)
b = DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
RouteMapPath     (DefaultMap PathMap (RouteMapT m a)
a DefaultMap PathMap (RouteMapT m a)
-> DefaultMap PathMap (RouteMapT m a)
-> DefaultMap PathMap (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> DefaultMap PathMap (RouteMapT m a)
b)
  RouteMapMethod   DefaultMap MethodMap (RouteMapT m a)
a <> RouteMapMethod   DefaultMap MethodMap (RouteMapT m a)
b = DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod   (DefaultMap MethodMap (RouteMapT m a)
a DefaultMap MethodMap (RouteMapT m a)
-> DefaultMap MethodMap (RouteMapT m a)
-> DefaultMap MethodMap (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> DefaultMap MethodMap (RouteMapT m a)
b)
  RouteMapQuery    QueryMap (RouteMapT m a)
a <> RouteMapQuery    QueryMap (RouteMapT m a)
b = QueryMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. QueryMap (RouteMapT m a) -> RouteMapT m a
RouteMapQuery    (QueryMap (RouteMapT m a)
a QueryMap (RouteMapT m a)
-> QueryMap (RouteMapT m a) -> QueryMap (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> QueryMap (RouteMapT m a)
b)
  RouteMapAccept   DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
a <> RouteMapAccept   DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
b = DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
RouteMapAccept   (DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
a DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
b)
  RouteMapCustom   ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
a <> RouteMapCustom   ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
b = ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
RouteMapCustom   (ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
a ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
b)
  RouteMapPriority Prioritized (RouteMapT m a)
a <> RouteMapPriority Prioritized (RouteMapT m a)
b = Prioritized (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
Prioritized (RouteMapT m a) -> RouteMapT m a
RouteMapPriority (Prioritized (RouteMapT m a)
a Prioritized (RouteMapT m a)
-> Prioritized (RouteMapT m a) -> Prioritized (RouteMapT m a)
forall a. Semigroup a => a -> a -> a
<> Prioritized (RouteMapT m a)
b)
  RouteMapExactly  Exactly (m a)
a <> RouteMapExactly  Exactly (m a)
b = Exactly (m a) -> RouteMapT m a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly  (Exactly (m a)
a Exactly (m a) -> Exactly (m a) -> Exactly (m a)
forall a. Semigroup a => a -> a -> a
<> Exactly (m a)
b)
  a :: RouteMapT m a
a@(RouteMapHost     DefaultMap HostMap (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
RouteMapHost (RouteMapT m a -> DefaultMap HostMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapHost     DefaultMap HostMap (RouteMapT m a)
_) =      DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
RouteMapHost (RouteMapT m a -> DefaultMap HostMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapSecure   BoolMap (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> BoolMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. BoolMap (RouteMapT m a) -> RouteMapT m a
RouteMapSecure (Maybe Bool -> RouteMapT m a -> BoolMap (RouteMapT m a)
forall a. Maybe Bool -> a -> BoolMap a
singletonBool Maybe Bool
forall a. Maybe a
Nothing RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapSecure   BoolMap (RouteMapT m a)
_) =      BoolMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. BoolMap (RouteMapT m a) -> RouteMapT m a
RouteMapSecure (Maybe Bool -> RouteMapT m a -> BoolMap (RouteMapT m a)
forall a. Maybe Bool -> a -> BoolMap a
singletonBool Maybe Bool
forall a. Maybe a
Nothing RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapPath     DefaultMap PathMap (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
RouteMapPath   (RouteMapT m a -> DefaultMap PathMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapPath     DefaultMap PathMap (RouteMapT m a)
_) =      DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
RouteMapPath   (RouteMapT m a -> DefaultMap PathMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapMethod   DefaultMap MethodMap (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod (RouteMapT m a -> DefaultMap MethodMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapMethod   DefaultMap MethodMap (RouteMapT m a)
_) =      DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod (RouteMapT m a -> DefaultMap MethodMap (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapQuery    QueryMap (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> QueryMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. QueryMap (RouteMapT m a) -> RouteMapT m a
RouteMapQuery  (RouteMapT m a -> QueryMap (RouteMapT m a)
forall a. a -> QueryMap a
defaultQueryMap RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapQuery    QueryMap (RouteMapT m a)
_) =      QueryMap (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a. QueryMap (RouteMapT m a) -> RouteMapT m a
RouteMapQuery  (RouteMapT m a -> QueryMap (RouteMapT m a)
forall a. a -> QueryMap a
defaultQueryMap RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapAccept   DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
RouteMapAccept (RouteMapT m a
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapAccept   DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
_) =      DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
RouteMapAccept (RouteMapT m a
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> DefaultMap m v
defaultingValue RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapCustom   ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
RouteMapCustom (RouteMapT m a
-> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> ConstMap m v
constantValue RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapCustom   ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
_) =      ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
forall (m :: * -> *) a.
ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
RouteMapCustom (RouteMapT m a
-> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
forall (m :: * -> *) v. Monoid (m v) => v -> ConstMap m v
constantValue RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b
  a :: RouteMapT m a
a@(RouteMapPriority Prioritized (RouteMapT m a)
_) <> RouteMapT m a
b = RouteMapT m a
a RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> Prioritized (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
Prioritized (RouteMapT m a) -> RouteMapT m a
RouteMapPriority (Int -> RouteMapT m a -> Prioritized (RouteMapT m a)
forall a. Int -> a -> Prioritized a
Prioritized Int
0 RouteMapT m a
b)
  RouteMapT m a
a <> b :: RouteMapT m a
b@(RouteMapPriority Prioritized (RouteMapT m a)
_) =      Prioritized (RouteMapT m a) -> RouteMapT m a
forall (m :: * -> *) a.
Prioritized (RouteMapT m a) -> RouteMapT m a
RouteMapPriority (Int -> RouteMapT m a -> Prioritized (RouteMapT m a)
forall a. Int -> a -> Prioritized a
Prioritized Int
0 RouteMapT m a
a) RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
<> RouteMapT m a
b

instance Monoid (RouteMapT m a) where
  mempty :: RouteMapT m a
mempty = Exactly (m a) -> RouteMapT m a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly Exactly (m a)
forall a. Exactly a
Blank
  mappend :: RouteMapT m a -> RouteMapT m a -> RouteMapT m a
mappend = RouteMapT m a -> RouteMapT m a -> RouteMapT m a
forall a. Semigroup a => a -> a -> a
(<>)

exactlyMap :: m a -> RouteMapT m a
exactlyMap :: m a -> RouteMapT m a
exactlyMap = Exactly (m a) -> RouteMapT m a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly (Exactly (m a) -> RouteMapT m a)
-> (m a -> Exactly (m a)) -> m a -> RouteMapT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Exactly (m a)
forall a. a -> Exactly a
Exactly

mapRoutes :: (m a -> RouteMapT n b) -> (RouteMapT m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapRoutes :: (m a -> RouteMapT n b)
-> (RouteMapT m a -> RouteMapT n b)
-> RouteMapT m a
-> RouteMapT n b
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapHost     DefaultMap HostMap (RouteMapT m a)
m) = DefaultMap HostMap (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a.
DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
RouteMapHost     (DefaultMap HostMap (RouteMapT n b) -> RouteMapT n b)
-> DefaultMap HostMap (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> DefaultMap HostMap (RouteMapT m a)
-> DefaultMap HostMap (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultMap HostMap (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapSecure   BoolMap (RouteMapT m a)
m) = BoolMap (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a. BoolMap (RouteMapT m a) -> RouteMapT m a
RouteMapSecure   (BoolMap (RouteMapT n b) -> RouteMapT n b)
-> BoolMap (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> BoolMap (RouteMapT m a) -> BoolMap (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolMap (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapPath     DefaultMap PathMap (RouteMapT m a)
m) = DefaultMap PathMap (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a.
DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
RouteMapPath     (DefaultMap PathMap (RouteMapT n b) -> RouteMapT n b)
-> DefaultMap PathMap (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> DefaultMap PathMap (RouteMapT m a)
-> DefaultMap PathMap (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultMap PathMap (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapMethod   DefaultMap MethodMap (RouteMapT m a)
m) = DefaultMap MethodMap (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod   (DefaultMap MethodMap (RouteMapT n b) -> RouteMapT n b)
-> DefaultMap MethodMap (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> DefaultMap MethodMap (RouteMapT m a)
-> DefaultMap MethodMap (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultMap MethodMap (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapQuery    QueryMap (RouteMapT m a)
m) = QueryMap (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a. QueryMap (RouteMapT m a) -> RouteMapT m a
RouteMapQuery    (QueryMap (RouteMapT n b) -> RouteMapT n b)
-> QueryMap (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> QueryMap (RouteMapT m a) -> QueryMap (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryMap (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapAccept   DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
m) = DefaultMap (MonoidHashMap ContentType) (RouteMapT n b)
-> RouteMapT n b
forall (m :: * -> *) a.
DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
RouteMapAccept   (DefaultMap (MonoidHashMap ContentType) (RouteMapT n b)
 -> RouteMapT n b)
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT n b)
-> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> DefaultMap (MonoidHashMap ContentType) (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapCustom   ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
m) = ConstMap (CustomMap Request Dynamic) (RouteMapT n b)
-> RouteMapT n b
forall (m :: * -> *) a.
ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
RouteMapCustom   (ConstMap (CustomMap Request Dynamic) (RouteMapT n b)
 -> RouteMapT n b)
-> ConstMap (CustomMap Request Dynamic) (RouteMapT n b)
-> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> ConstMap (CustomMap Request Dynamic) (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
f (RouteMapPriority Prioritized (RouteMapT m a)
m) = Prioritized (RouteMapT n b) -> RouteMapT n b
forall (m :: * -> *) a.
Prioritized (RouteMapT m a) -> RouteMapT m a
RouteMapPriority (Prioritized (RouteMapT n b) -> RouteMapT n b)
-> Prioritized (RouteMapT n b) -> RouteMapT n b
forall a b. (a -> b) -> a -> b
$ RouteMapT m a -> RouteMapT n b
f (RouteMapT m a -> RouteMapT n b)
-> Prioritized (RouteMapT m a) -> Prioritized (RouteMapT n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Prioritized (RouteMapT m a)
m
mapRoutes m a -> RouteMapT n b
f RouteMapT m a -> RouteMapT n b
_ (RouteMapExactly (Exactly m a
a)) = m a -> RouteMapT n b
f m a
a
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
_ (RouteMapExactly Exactly (m a)
Blank) = Exactly (n b) -> RouteMapT n b
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly Exactly (n b)
forall a. Exactly a
Blank
mapRoutes m a -> RouteMapT n b
_ RouteMapT m a -> RouteMapT n b
_ (RouteMapExactly Exactly (m a)
Conflict) = Exactly (n b) -> RouteMapT n b
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly Exactly (n b)
forall a. Exactly a
Conflict

mapTails :: (m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails :: (m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails m a -> RouteMapT n b
f = (m a -> RouteMapT n b)
-> (RouteMapT m a -> RouteMapT n b)
-> RouteMapT m a
-> RouteMapT n b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b)
-> (RouteMapT m a -> RouteMapT n b)
-> RouteMapT m a
-> RouteMapT n b
mapRoutes m a -> RouteMapT n b
f ((m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails m a -> RouteMapT n b
f)

mapRoute :: (m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute :: (m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute m a -> n b
f = (m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails (n b -> RouteMapT n b
forall (m :: * -> *) a. m a -> RouteMapT m a
exactlyMap (n b -> RouteMapT n b) -> (m a -> n b) -> m a -> RouteMapT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n b
f)

instance Functor f => Functor (RouteMapT f) where
  fmap :: (a -> b) -> RouteMapT f a -> RouteMapT f b
fmap a -> b
f = (f a -> f b) -> RouteMapT f a -> RouteMapT f b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

instance Applicative f => Applicative (RouteMapT f) where
  pure :: a -> RouteMapT f a
pure = f a -> RouteMapT f a
forall (m :: * -> *) a. m a -> RouteMapT m a
exactlyMap (f a -> RouteMapT f a) -> (a -> f a) -> a -> RouteMapT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  RouteMapT f (a -> b)
f <*> :: RouteMapT f (a -> b) -> RouteMapT f a -> RouteMapT f b
<*> RouteMapT f a
m = (f (a -> b) -> RouteMapT f b)
-> RouteMapT f (a -> b) -> RouteMapT f b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails (\f (a -> b)
f' -> (f a -> f b) -> RouteMapT f a -> RouteMapT f b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute (f (a -> b)
f' f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) RouteMapT f a
m) RouteMapT f (a -> b)
f
  RouteMapT f a
f  *> :: RouteMapT f a -> RouteMapT f b -> RouteMapT f b
*> RouteMapT f b
m = (f a -> RouteMapT f b) -> RouteMapT f a -> RouteMapT f b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b) -> RouteMapT m a -> RouteMapT n b
mapTails (\f a
f' -> (f b -> f b) -> RouteMapT f b -> RouteMapT f b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute (f a
f'  f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) RouteMapT f b
m) RouteMapT f a
f

instance Applicative f => Alternative (RouteMapT f) where
  empty :: RouteMapT f a
empty = Exactly (f a) -> RouteMapT f a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly (Exactly (f a) -> RouteMapT f a) -> Exactly (f a) -> RouteMapT f a
forall a b. (a -> b) -> a -> b
$ Exactly (f a)
forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: RouteMapT f a -> RouteMapT f a -> RouteMapT f a
(<|>) = RouteMapT f a -> RouteMapT f a -> RouteMapT f a
forall a. Monoid a => a -> a -> a
mappend

instance MonadTrans RouteMapT where
  lift :: m a -> RouteMapT m a
lift = m a -> RouteMapT m a
forall (m :: * -> *) a. m a -> RouteMapT m a
exactlyMap

type RouteState = RouteMapT DynamicState
-- |The type of a route map element created from a single 'Route'.
-- These may be combined into a final 'RouteMap'.
-- (Currently these are in fact the same representation, but this may change.)
type RouteCase = RouteMapT ((->) Dynamics)
-- |A map for efficiently looking up requests based on a set of individual route specifications.
type RouteMap = RouteCase

sequenceState :: RouteString s => Sequence s a -> DefaultMap (SequenceMap s) (RouteState a)
sequenceState :: Sequence s a -> DefaultMap (SequenceMap s) (RouteState a)
sequenceState Sequence s a
s = SequenceMap s (RouteState a)
-> DefaultMap (SequenceMap s) (RouteState a)
forall (m :: * -> *) v. m v -> DefaultMap m v
defaultingMap (SequenceMap s (RouteState a)
 -> DefaultMap (SequenceMap s) (RouteState a))
-> SequenceMap s (RouteState a)
-> DefaultMap (SequenceMap s) (RouteState a)
forall a b. (a -> b) -> a -> b
$ Exactly (StateT Dynamics Identity a) -> RouteState a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly (Exactly (StateT Dynamics Identity a) -> RouteState a)
-> (StateT Dynamics Identity a
    -> Exactly (StateT Dynamics Identity a))
-> StateT Dynamics Identity a
-> RouteState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Dynamics Identity a -> Exactly (StateT Dynamics Identity a)
forall a. a -> Exactly a
Exactly (StateT Dynamics Identity a -> RouteState a)
-> SequenceMap s (StateT Dynamics Identity a)
-> SequenceMap s (RouteState a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sequence s a -> SequenceMap s (StateT Dynamics Identity a)
forall s a.
RouteString s =>
Sequence s a -> SequenceMap s (DynamicState a)
singletonSequence Sequence s a
s

predicateState :: RoutePredicate a -> RouteState a
predicateState :: RoutePredicate a -> RouteState a
predicateState (RouteHost (HostRev Sequence ContentType a
s)) = DefaultMap HostMap (RouteState a) -> RouteState a
forall (m :: * -> *) a.
DefaultMap HostMap (RouteMapT m a) -> RouteMapT m a
RouteMapHost (DefaultMap HostMap (RouteState a) -> RouteState a)
-> DefaultMap HostMap (RouteState a) -> RouteState a
forall a b. (a -> b) -> a -> b
$ Sequence ContentType a -> DefaultMap HostMap (RouteState a)
forall s a.
RouteString s =>
Sequence s a -> DefaultMap (SequenceMap s) (RouteState a)
sequenceState Sequence ContentType a
s
predicateState (RouteSecure Bool
s) = BoolMap (RouteMapT DynamicState ()) -> RouteMapT DynamicState ()
forall (m :: * -> *) a. BoolMap (RouteMapT m a) -> RouteMapT m a
RouteMapSecure (BoolMap (RouteMapT DynamicState ()) -> RouteMapT DynamicState ())
-> BoolMap (RouteMapT DynamicState ()) -> RouteMapT DynamicState ()
forall a b. (a -> b) -> a -> b
$ Maybe Bool
-> RouteMapT DynamicState () -> BoolMap (RouteMapT DynamicState ())
forall a. Maybe Bool -> a -> BoolMap a
singletonBool (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
s) (RouteMapT DynamicState () -> BoolMap (RouteMapT DynamicState ()))
-> RouteMapT DynamicState () -> BoolMap (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ () -> RouteMapT DynamicState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
predicateState (RoutePath (Path Sequence PathString a
s)) = DefaultMap PathMap (RouteState a) -> RouteState a
forall (m :: * -> *) a.
DefaultMap PathMap (RouteMapT m a) -> RouteMapT m a
RouteMapPath (DefaultMap PathMap (RouteState a) -> RouteState a)
-> DefaultMap PathMap (RouteState a) -> RouteState a
forall a b. (a -> b) -> a -> b
$ Sequence PathString a -> DefaultMap PathMap (RouteState a)
forall s a.
RouteString s =>
Sequence s a -> DefaultMap (SequenceMap s) (RouteState a)
sequenceState Sequence PathString a
s
predicateState (RouteMethod Method
m) = DefaultMap MethodMap (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod (DefaultMap MethodMap (RouteMapT DynamicState ())
 -> RouteMapT DynamicState ())
-> DefaultMap MethodMap (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall a b. (a -> b) -> a -> b
$ MonoidMap Method (RouteMapT DynamicState ())
-> DefaultMap MethodMap (RouteMapT DynamicState ())
forall (m :: * -> *) v. m v -> DefaultMap m v
defaultingMap (MonoidMap Method (RouteMapT DynamicState ())
 -> DefaultMap MethodMap (RouteMapT DynamicState ()))
-> MonoidMap Method (RouteMapT DynamicState ())
-> DefaultMap MethodMap (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ Map Method (RouteMapT DynamicState ())
-> MonoidMap Method (RouteMapT DynamicState ())
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map Method (RouteMapT DynamicState ())
 -> MonoidMap Method (RouteMapT DynamicState ()))
-> Map Method (RouteMapT DynamicState ())
-> MonoidMap Method (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ Method
-> RouteMapT DynamicState ()
-> Map Method (RouteMapT DynamicState ())
forall k a. k -> a -> Map k a
Map.singleton Method
m (RouteMapT DynamicState ()
 -> Map Method (RouteMapT DynamicState ()))
-> RouteMapT DynamicState ()
-> Map Method (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ () -> RouteMapT DynamicState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
predicateState (RouteQuery ContentType
n Placeholder ContentType a
p) = QueryMap (RouteState a) -> RouteState a
forall (m :: * -> *) a. QueryMap (RouteMapT m a) -> RouteMapT m a
RouteMapQuery (QueryMap (RouteState a) -> RouteState a)
-> QueryMap (RouteState a) -> RouteState a
forall a b. (a -> b) -> a -> b
$ Exactly (StateT Dynamics Identity a) -> RouteState a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly (Exactly (StateT Dynamics Identity a) -> RouteState a)
-> (StateT Dynamics Identity a
    -> Exactly (StateT Dynamics Identity a))
-> StateT Dynamics Identity a
-> RouteState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Dynamics Identity a -> Exactly (StateT Dynamics Identity a)
forall a. a -> Exactly a
Exactly (StateT Dynamics Identity a -> RouteState a)
-> QueryMap (StateT Dynamics Identity a) -> QueryMap (RouteState a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentType
-> Placeholder ContentType a
-> QueryMap (StateT Dynamics Identity a)
forall p.
ContentType
-> Placeholder ContentType p -> QueryMap (DynamicState p)
singletonQueryState ContentType
n Placeholder ContentType a
p
predicateState (RouteAccept ContentType
t) = DefaultMap (MonoidHashMap ContentType) (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall (m :: * -> *) a.
DefaultMap (MonoidHashMap ContentType) (RouteMapT m a)
-> RouteMapT m a
RouteMapAccept (DefaultMap (MonoidHashMap ContentType) (RouteMapT DynamicState ())
 -> RouteMapT DynamicState ())
-> DefaultMap
     (MonoidHashMap ContentType) (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall a b. (a -> b) -> a -> b
$ MonoidHashMap ContentType (RouteMapT DynamicState ())
-> DefaultMap
     (MonoidHashMap ContentType) (RouteMapT DynamicState ())
forall (m :: * -> *) v. m v -> DefaultMap m v
defaultingMap (MonoidHashMap ContentType (RouteMapT DynamicState ())
 -> DefaultMap
      (MonoidHashMap ContentType) (RouteMapT DynamicState ()))
-> MonoidHashMap ContentType (RouteMapT DynamicState ())
-> DefaultMap
     (MonoidHashMap ContentType) (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ HashMap ContentType (RouteMapT DynamicState ())
-> MonoidHashMap ContentType (RouteMapT DynamicState ())
forall k a. HashMap k a -> MonoidHashMap k a
MonoidHashMap (HashMap ContentType (RouteMapT DynamicState ())
 -> MonoidHashMap ContentType (RouteMapT DynamicState ()))
-> HashMap ContentType (RouteMapT DynamicState ())
-> MonoidHashMap ContentType (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ ContentType
-> RouteMapT DynamicState ()
-> HashMap ContentType (RouteMapT DynamicState ())
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton ContentType
t (RouteMapT DynamicState ()
 -> HashMap ContentType (RouteMapT DynamicState ()))
-> RouteMapT DynamicState ()
-> HashMap ContentType (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ () -> RouteMapT DynamicState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
predicateState (RouteCustom Request -> Maybe a
f a -> Request -> Request
_) = ConstMap (CustomMap Request Dynamic) (RouteState a) -> RouteState a
forall (m :: * -> *) a.
ConstMap (CustomMap Request Dynamic) (RouteMapT m a)
-> RouteMapT m a
RouteMapCustom (ConstMap (CustomMap Request Dynamic) (RouteState a)
 -> RouteState a)
-> ConstMap (CustomMap Request Dynamic) (RouteState a)
-> RouteState a
forall a b. (a -> b) -> a -> b
$ CustomMap Request Dynamic (RouteState a)
-> ConstMap (CustomMap Request Dynamic) (RouteState a)
forall v (m :: * -> *). Monoid v => m v -> ConstMap m v
constantMap (CustomMap Request Dynamic (RouteState a)
 -> ConstMap (CustomMap Request Dynamic) (RouteState a))
-> CustomMap Request Dynamic (RouteState a)
-> ConstMap (CustomMap Request Dynamic) (RouteState a)
forall a b. (a -> b) -> a -> b
$ (Request -> Maybe Dynamic)
-> RouteState a -> CustomMap Request Dynamic (RouteState a)
forall q a b. (q -> Maybe a) -> b -> CustomMap q a b
singletonCustom ((a -> Dynamic) -> Maybe a -> Maybe Dynamic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (Maybe a -> Maybe Dynamic)
-> (Request -> Maybe a) -> Request -> Maybe Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Maybe a
f) (RouteState a -> CustomMap Request Dynamic (RouteState a))
-> RouteState a -> CustomMap Request Dynamic (RouteState a)
forall a b. (a -> b) -> a -> b
$
  Exactly (StateT Dynamics Identity a) -> RouteState a
forall (m :: * -> *) a. Exactly (m a) -> RouteMapT m a
RouteMapExactly (Exactly (StateT Dynamics Identity a) -> RouteState a)
-> Exactly (StateT Dynamics Identity a) -> RouteState a
forall a b. (a -> b) -> a -> b
$ StateT Dynamics Identity a -> Exactly (StateT Dynamics Identity a)
forall a. a -> Exactly a
Exactly (StateT Dynamics Identity a
 -> Exactly (StateT Dynamics Identity a))
-> StateT Dynamics Identity a
-> Exactly (StateT Dynamics Identity a)
forall a b. (a -> b) -> a -> b
$ StateT Dynamics Identity a
forall a. Typeable a => DynamicState a
getDynamic
predicateState (RoutePriority Int
p) = Prioritized (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall (m :: * -> *) a.
Prioritized (RouteMapT m a) -> RouteMapT m a
RouteMapPriority (Prioritized (RouteMapT DynamicState ())
 -> RouteMapT DynamicState ())
-> Prioritized (RouteMapT DynamicState ())
-> RouteMapT DynamicState ()
forall a b. (a -> b) -> a -> b
$ Int
-> RouteMapT DynamicState ()
-> Prioritized (RouteMapT DynamicState ())
forall a. Int -> a -> Prioritized a
Prioritized Int
p (RouteMapT DynamicState ()
 -> Prioritized (RouteMapT DynamicState ()))
-> RouteMapT DynamicState ()
-> Prioritized (RouteMapT DynamicState ())
forall a b. (a -> b) -> a -> b
$ () -> RouteMapT DynamicState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

routeState :: Route a -> RouteState a
routeState :: Route a -> RouteState a
routeState (Route Free RoutePredicate a
r) = Free (RouteMapT DynamicState) a -> RouteState a
forall (f :: * -> *) a. Alternative f => Free f a -> f a
runFree (Free (RouteMapT DynamicState) a -> RouteState a)
-> Free (RouteMapT DynamicState) a -> RouteState a
forall a b. (a -> b) -> a -> b
$ (forall a'. RoutePredicate a' -> RouteMapT DynamicState a')
-> Free RoutePredicate a -> Free (RouteMapT DynamicState) a
forall (f :: * -> *) (m :: * -> *) a.
(forall a'. f a' -> m a') -> Free f a -> Free m a
mapFree forall a'. RoutePredicate a' -> RouteMapT DynamicState a'
predicateState Free RoutePredicate a
r

-- |Convert a 'Route' and result generator to a single entry in the routing table.
routeCase :: RouteAction a b -> RouteCase b
routeCase :: RouteAction a b -> RouteCase b
routeCase (RouteAction Route a
r a -> b
f) = (StateT Dynamics Identity a -> Dynamics -> b)
-> RouteMapT DynamicState a -> RouteCase b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute (\StateT Dynamics Identity a
s -> a -> b
f (a -> b) -> (Dynamics -> a) -> Dynamics -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Dynamics Identity a -> Dynamics -> a
forall s a. State s a -> s -> a
evalState StateT Dynamics Identity a
s) (RouteMapT DynamicState a -> RouteCase b)
-> RouteMapT DynamicState a -> RouteCase b
forall a b. (a -> b) -> a -> b
$ Route a -> RouteMapT DynamicState a
forall a. Route a -> RouteState a
routeState Route a
r

-- |Combine 'routeCase' and 'normRoute'.
-- See the description of 'normRoute' for an explaination.
routeNormCase :: RouteAction a b -> RouteCase b
routeNormCase :: RouteAction a b -> RouteCase b
routeNormCase (RouteAction Route a
r a -> b
f) = (StateT Dynamics Identity a -> Dynamics -> b)
-> RouteMapT DynamicState a -> RouteCase b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> RouteMapT m a -> RouteMapT n b
mapRoute (\StateT Dynamics Identity a
s -> a -> b
f (a -> b) -> (Dynamics -> a) -> Dynamics -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Dynamics Identity a -> Dynamics -> a
forall s a. State s a -> s -> a
evalState StateT Dynamics Identity a
s) (RouteMapT DynamicState a -> RouteCase b)
-> RouteMapT DynamicState a -> RouteCase b
forall a b. (a -> b) -> a -> b
$ Route a -> RouteMapT DynamicState a
forall a. Route a -> RouteState a
routeState (Route a -> RouteMapT DynamicState a)
-> Route a -> RouteMapT DynamicState a
forall a b. (a -> b) -> a -> b
$ Route a -> Route a
forall a. Route a -> Route a
normRoute Route a
r

-- |Combine a list of routes to a single map.
routes :: [RouteCase a] -> RouteMap a
routes :: [RouteCase a] -> RouteCase a
routes = [RouteCase a] -> RouteCase a
forall a. Monoid a => [a] -> a
mconcat

-- |Make any handler for a 'GET' method in the map also apply to 'HEAD' requests, provided there is not an existing handler.
-- A number of frameworks can automatically convert your @GET@ responses into @HEAD@ responses, so this is useful (if slightly wasteful) in those cases.
fallbackHEADtoGET :: RouteMap a -> RouteMap a
fallbackHEADtoGET :: RouteMap a -> RouteMap a
fallbackHEADtoGET (RouteMapMethod DefaultMap MethodMap (RouteMap a)
m) = DefaultMap MethodMap (RouteMap a) -> RouteMap a
forall (m :: * -> *) a.
DefaultMap MethodMap (RouteMapT m a) -> RouteMapT m a
RouteMapMethod (DefaultMap MethodMap (RouteMap a) -> RouteMap a)
-> DefaultMap MethodMap (RouteMap a) -> RouteMap a
forall a b. (a -> b) -> a -> b
$ DefaultMap MethodMap (RouteMap a)
-> DefaultMap MethodMap (RouteMap a)
forall a. DefaultMap MethodMap a -> DefaultMap MethodMap a
fallbackDefaultMethodHEADtoGET (DefaultMap MethodMap (RouteMap a)
 -> DefaultMap MethodMap (RouteMap a))
-> DefaultMap MethodMap (RouteMap a)
-> DefaultMap MethodMap (RouteMap a)
forall a b. (a -> b) -> a -> b
$ RouteMap a -> RouteMap a
forall a. RouteMap a -> RouteMap a
fallbackHEADtoGET (RouteMap a -> RouteMap a)
-> DefaultMap MethodMap (RouteMap a)
-> DefaultMap MethodMap (RouteMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultMap MethodMap (RouteMap a)
m
fallbackHEADtoGET RouteMap a
m = ((Dynamics -> a) -> RouteMap a)
-> (RouteMap a -> RouteMap a) -> RouteMap a -> RouteMap a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> RouteMapT n b)
-> (RouteMapT m a -> RouteMapT n b)
-> RouteMapT m a
-> RouteMapT n b
mapRoutes (Dynamics -> a) -> RouteMap a
forall (m :: * -> *) a. m a -> RouteMapT m a
exactlyMap RouteMap a -> RouteMap a
forall a. RouteMap a -> RouteMap a
fallbackHEADtoGET RouteMap a
m

-- |Lookup a value in a routing table based on a 'Request'.
-- This returns the action returned by the 'route' that can handle this request, wrapped in a 'RouteResult' in case of error.
lookupRoute :: Request -> RouteMap a -> RouteResult a
lookupRoute :: Request -> RouteMap a -> RouteResult a
lookupRoute q :: Request
q@Request{Bool
[ContentType]
[PathString]
ContentType
QueryParams
Method
requestContentType :: Request -> ContentType
requestQuery :: Request -> QueryParams
requestPath :: Request -> [PathString]
requestMethod :: Request -> Method
requestHost :: Request -> [ContentType]
requestSecure :: Request -> Bool
requestContentType :: ContentType
requestQuery :: QueryParams
requestPath :: [PathString]
requestMethod :: Method
requestHost :: [ContentType]
requestSecure :: Bool
..} = (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
forall a. a -> a
id where
  rr :: (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
  rr :: (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
_ (RouteMapExactly Exactly (Dynamics -> a)
Blank) = RouteResult a
forall a. RouteResult a
RouteNotFound
  rr Dynamics -> Dynamics
p (RouteMapExactly (Exactly Dynamics -> a
a)) = a -> RouteResult a
forall a. a -> RouteResult a
RouteResult (a -> RouteResult a) -> a -> RouteResult a
forall a b. (a -> b) -> a -> b
$ Dynamics -> a
a (Dynamics -> a) -> Dynamics -> a
forall a b. (a -> b) -> a -> b
$ Dynamics -> Dynamics
p []
  rr Dynamics -> Dynamics
_ (RouteMapExactly Exactly (Dynamics -> a)
Conflict) = RouteResult a
forall a. RouteResult a
MultipleRoutes
  rr Dynamics -> Dynamics
p (RouteMapPriority (Prioritized Int
_ RouteMap a
r)) = (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
p RouteMap a
r
  rr Dynamics -> Dynamics
p (RouteMapCustom (ConstMap CustomMap Request Dynamic (RouteMap a)
m RouteMap a
cm)) =
    ((Dynamic, RouteMap a) -> RouteResult a)
-> [(Dynamic, RouteMap a)] -> RouteResult a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Dynamic
x, RouteMap a
rm) -> (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr (Dynamics -> Dynamics
p (Dynamics -> Dynamics)
-> (Dynamics -> Dynamics) -> Dynamics -> Dynamics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dynamic
xDynamic -> Dynamics -> Dynamics
forall a. a -> [a] -> [a]
:)) RouteMap a
rm) (Request
-> CustomMap Request Dynamic (RouteMap a)
-> [(Dynamic, RouteMap a)]
forall q a b. q -> CustomMap q a b -> [(a, b)]
lookupCustom Request
q CustomMap Request Dynamic (RouteMap a)
m) RouteResult a -> RouteResult a -> RouteResult a
forall a. Semigroup a => a -> a -> a
<> (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
p RouteMap a
cm
  rr Dynamics -> Dynamics
p (RouteMapAccept DefaultMap (MonoidHashMap ContentType) (RouteMap a)
m) = (Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
forall a.
(Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
mayber Dynamics -> Dynamics
p (Maybe (RouteMap a) -> RouteResult a)
-> Maybe (RouteMap a) -> RouteResult a
forall a b. (a -> b) -> a -> b
$ (MonoidHashMap ContentType (RouteMap a) -> Maybe (RouteMap a))
-> DefaultMap (MonoidHashMap ContentType) (RouteMap a)
-> Maybe (RouteMap a)
forall (m :: * -> *) v.
(m v -> Maybe v) -> DefaultMap m v -> Maybe v
lookupDefault (ContentType
-> HashMap ContentType (RouteMap a) -> Maybe (RouteMap a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ContentType
requestContentType (HashMap ContentType (RouteMap a) -> Maybe (RouteMap a))
-> (MonoidHashMap ContentType (RouteMap a)
    -> HashMap ContentType (RouteMap a))
-> MonoidHashMap ContentType (RouteMap a)
-> Maybe (RouteMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidHashMap ContentType (RouteMap a)
-> HashMap ContentType (RouteMap a)
forall k a. MonoidHashMap k a -> HashMap k a
monoidHashMap) DefaultMap (MonoidHashMap ContentType) (RouteMap a)
m
  rr Dynamics -> Dynamics
p (RouteMapQuery QueryMap (RouteMap a)
m) = (Dynamics -> Dynamics)
-> [DynamicResult (RouteMap a)] -> RouteResult a
forall a.
(Dynamics -> Dynamics)
-> [DynamicResult (RouteMap a)] -> RouteResult a
dynr Dynamics -> Dynamics
p ([DynamicResult (RouteMap a)] -> RouteResult a)
-> [DynamicResult (RouteMap a)] -> RouteResult a
forall a b. (a -> b) -> a -> b
$ QueryParams
-> QueryMap (RouteMap a) -> [DynamicResult (RouteMap a)]
forall a. QueryParams -> QueryMap a -> [DynamicResult a]
lookupQuery QueryParams
requestQuery QueryMap (RouteMap a)
m
  rr Dynamics -> Dynamics
p (RouteMapMethod DefaultMap MethodMap (RouteMap a)
m) = ([Method] -> RouteResult a)
-> (RouteMap a -> RouteResult a)
-> Either [Method] (RouteMap a)
-> RouteResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Method] -> RouteResult a
forall a. [Method] -> RouteResult a
AllowedMethods ((Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
p)
    (Either [Method] (RouteMap a) -> RouteResult a)
-> Either [Method] (RouteMap a) -> RouteResult a
forall a b. (a -> b) -> a -> b
$ Method
-> DefaultMap MethodMap (RouteMap a)
-> Either [Method] (RouteMap a)
forall a. Method -> DefaultMap MethodMap a -> Either [Method] a
lookupDefaultMethod Method
requestMethod DefaultMap MethodMap (RouteMap a)
m
  rr Dynamics -> Dynamics
p (RouteMapPath DefaultMap PathMap (RouteMap a)
m) = (Dynamics -> Dynamics)
-> [PathString] -> DefaultMap PathMap (RouteMap a) -> RouteResult a
forall s a.
RouteString s =>
(Dynamics -> Dynamics)
-> [s] -> DefaultMap (SequenceMap s) (RouteMap a) -> RouteResult a
seqr Dynamics -> Dynamics
p [PathString]
requestPath DefaultMap PathMap (RouteMap a)
m
  rr Dynamics -> Dynamics
p (RouteMapSecure BoolMap (RouteMap a)
m) = (Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
forall a.
(Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
mayber Dynamics -> Dynamics
p
    (Maybe (RouteMap a) -> RouteResult a)
-> Maybe (RouteMap a) -> RouteResult a
forall a b. (a -> b) -> a -> b
$ Bool -> BoolMap (RouteMap a) -> Maybe (RouteMap a)
forall a. Bool -> BoolMap a -> Maybe a
lookupBool Bool
requestSecure BoolMap (RouteMap a)
m
  rr Dynamics -> Dynamics
p (RouteMapHost DefaultMap HostMap (RouteMap a)
m) = (Dynamics -> Dynamics)
-> [ContentType]
-> DefaultMap HostMap (RouteMap a)
-> RouteResult a
forall s a.
RouteString s =>
(Dynamics -> Dynamics)
-> [s] -> DefaultMap (SequenceMap s) (RouteMap a) -> RouteResult a
seqr Dynamics -> Dynamics
p [ContentType]
requestHost DefaultMap HostMap (RouteMap a)
m
  mayber :: (Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
  mayber :: (Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
mayber Dynamics -> Dynamics
p = RouteResult a
-> (RouteMap a -> RouteResult a)
-> Maybe (RouteMap a)
-> RouteResult a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RouteResult a
forall a. RouteResult a
RouteNotFound ((Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr Dynamics -> Dynamics
p)
  dynr :: (Dynamics -> Dynamics) -> [DynamicResult (RouteMap a)] -> RouteResult a
  dynr :: (Dynamics -> Dynamics)
-> [DynamicResult (RouteMap a)] -> RouteResult a
dynr Dynamics -> Dynamics
p = (DynamicResult (RouteMap a) -> RouteResult a)
-> [DynamicResult (RouteMap a)] -> RouteResult a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Dynamics
x, RouteMap a
rm) -> (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
forall a. (Dynamics -> Dynamics) -> RouteMap a -> RouteResult a
rr (Dynamics -> Dynamics
p (Dynamics -> Dynamics)
-> (Dynamics -> Dynamics) -> Dynamics -> Dynamics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dynamics
x Dynamics -> Dynamics -> Dynamics
forall a. [a] -> [a] -> [a]
++)) RouteMap a
rm)
  seqr :: RouteString s => (Dynamics -> Dynamics) -> [s] -> DefaultMap (SequenceMap s) (RouteMap a) -> RouteResult a
  seqr :: (Dynamics -> Dynamics)
-> [s] -> DefaultMap (SequenceMap s) (RouteMap a) -> RouteResult a
seqr Dynamics -> Dynamics
p [s]
k (DefaultMap SequenceMap s (RouteMap a)
m Maybe (RouteMap a)
d) = case [s] -> SequenceMap s (RouteMap a) -> [DynamicResult (RouteMap a)]
forall s a.
RouteString s =>
[s] -> SequenceMap s a -> [DynamicResult a]
lookupSequence [s]
k SequenceMap s (RouteMap a)
m of
    [] -> (Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
forall a.
(Dynamics -> Dynamics) -> Maybe (RouteMap a) -> RouteResult a
mayber Dynamics -> Dynamics
p Maybe (RouteMap a)
d
    [DynamicResult (RouteMap a)]
l -> (Dynamics -> Dynamics)
-> [DynamicResult (RouteMap a)] -> RouteResult a
forall a.
(Dynamics -> Dynamics)
-> [DynamicResult (RouteMap a)] -> RouteResult a
dynr Dynamics -> Dynamics
p [DynamicResult (RouteMap a)]
l