{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module Web.Routing.Router where

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative
#endif
import Control.Monad.RWS.Strict
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import Data.Maybe
import qualified Data.Text as T
import Web.Routing.SafeRouting

newtype RegistryT n b middleware reqTypes (m :: * -> *) a = RegistryT
  { forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
RegistryT n b middleware reqTypes m a
-> RWST
     (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a
runRegistryT :: RWST (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a
  }
  deriving
    ( Applicative (RegistryT n b middleware reqTypes m)
Applicative (RegistryT n b middleware reqTypes m) =>
(forall a b.
 RegistryT n b middleware reqTypes m a
 -> (a -> RegistryT n b middleware reqTypes m b)
 -> RegistryT n b middleware reqTypes m b)
-> (forall a b.
    RegistryT n b middleware reqTypes m a
    -> RegistryT n b middleware reqTypes m b
    -> RegistryT n b middleware reqTypes m b)
-> (forall a. a -> RegistryT n b middleware reqTypes m a)
-> Monad (RegistryT n b middleware reqTypes m)
forall a. a -> RegistryT n b middleware reqTypes m a
forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
forall a b.
RegistryT n b middleware reqTypes m a
-> (a -> RegistryT n b middleware reqTypes m b)
-> RegistryT n b middleware reqTypes m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (n :: * -> *) b middleware reqTypes (m :: * -> *).
Monad m =>
Applicative (RegistryT n b middleware reqTypes m)
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
a -> RegistryT n b middleware reqTypes m a
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> (a -> RegistryT n b middleware reqTypes m b)
-> RegistryT n b middleware reqTypes m b
$c>>= :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> (a -> RegistryT n b middleware reqTypes m b)
-> RegistryT n b middleware reqTypes m b
>>= :: forall a b.
RegistryT n b middleware reqTypes m a
-> (a -> RegistryT n b middleware reqTypes m b)
-> RegistryT n b middleware reqTypes m b
$c>> :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
>> :: forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
$creturn :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
a -> RegistryT n b middleware reqTypes m a
return :: forall a. a -> RegistryT n b middleware reqTypes m a
Monad,
      (forall a b.
 (a -> b)
 -> RegistryT n b middleware reqTypes m a
 -> RegistryT n b middleware reqTypes m b)
-> (forall a b.
    a
    -> RegistryT n b middleware reqTypes m b
    -> RegistryT n b middleware reqTypes m a)
-> Functor (RegistryT n b middleware reqTypes m)
forall a b.
a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
forall a b.
(a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Functor m =>
a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Functor m =>
(a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
$cfmap :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Functor m =>
(a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
fmap :: forall a b.
(a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
$c<$ :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Functor m =>
a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
<$ :: forall a b.
a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
Functor,
      Functor (RegistryT n b middleware reqTypes m)
Functor (RegistryT n b middleware reqTypes m) =>
(forall a. a -> RegistryT n b middleware reqTypes m a)
-> (forall a b.
    RegistryT n b middleware reqTypes m (a -> b)
    -> RegistryT n b middleware reqTypes m a
    -> RegistryT n b middleware reqTypes m b)
-> (forall a b c.
    (a -> b -> c)
    -> RegistryT n b middleware reqTypes m a
    -> RegistryT n b middleware reqTypes m b
    -> RegistryT n b middleware reqTypes m c)
-> (forall a b.
    RegistryT n b middleware reqTypes m a
    -> RegistryT n b middleware reqTypes m b
    -> RegistryT n b middleware reqTypes m b)
-> (forall a b.
    RegistryT n b middleware reqTypes m a
    -> RegistryT n b middleware reqTypes m b
    -> RegistryT n b middleware reqTypes m a)
-> Applicative (RegistryT n b middleware reqTypes m)
forall a. a -> RegistryT n b middleware reqTypes m a
forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
forall a b.
RegistryT n b middleware reqTypes m (a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
forall a b c.
(a -> b -> c)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (n :: * -> *) b middleware reqTypes (m :: * -> *).
Monad m =>
Functor (RegistryT n b middleware reqTypes m)
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
a -> RegistryT n b middleware reqTypes m a
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m (a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m c
$cpure :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
a -> RegistryT n b middleware reqTypes m a
pure :: forall a. a -> RegistryT n b middleware reqTypes m a
$c<*> :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m (a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
<*> :: forall a b.
RegistryT n b middleware reqTypes m (a -> b)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
$cliftA2 :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m c
liftA2 :: forall a b c.
(a -> b -> c)
-> RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m c
$c*> :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
*> :: forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m b
$c<* :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a b.
Monad m =>
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
<* :: forall a b.
RegistryT n b middleware reqTypes m a
-> RegistryT n b middleware reqTypes m b
-> RegistryT n b middleware reqTypes m a
Applicative,
      Monad (RegistryT n b middleware reqTypes m)
Monad (RegistryT n b middleware reqTypes m) =>
(forall a. IO a -> RegistryT n b middleware reqTypes m a)
-> MonadIO (RegistryT n b middleware reqTypes m)
forall a. IO a -> RegistryT n b middleware reqTypes m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (n :: * -> *) b middleware reqTypes (m :: * -> *).
MonadIO m =>
Monad (RegistryT n b middleware reqTypes m)
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
MonadIO m =>
IO a -> RegistryT n b middleware reqTypes m a
$cliftIO :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
MonadIO m =>
IO a -> RegistryT n b middleware reqTypes m a
liftIO :: forall a. IO a -> RegistryT n b middleware reqTypes m a
MonadIO,
      MonadReader (PathInternal '[]),
      MonadWriter [middleware],
      MonadState (RegistryState n b reqTypes),
      (forall (m :: * -> *).
 Monad m =>
 Monad (RegistryT n b middleware reqTypes m)) =>
(forall (m :: * -> *) a.
 Monad m =>
 m a -> RegistryT n b middleware reqTypes m a)
-> MonadTrans (RegistryT n b middleware reqTypes)
forall (m :: * -> *).
Monad m =>
Monad (RegistryT n b middleware reqTypes m)
forall (m :: * -> *) a.
Monad m =>
m a -> RegistryT n b middleware reqTypes m a
forall (n :: * -> *) b middleware reqTypes (m :: * -> *).
Monad m =>
Monad (RegistryT n b middleware reqTypes m)
forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
m a -> RegistryT n b middleware reqTypes m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a.
Monad m =>
m a -> RegistryT n b middleware reqTypes m a
lift :: forall (m :: * -> *) a.
Monad m =>
m a -> RegistryT n b middleware reqTypes m a
MonadTrans
    )

data RegistryState n b reqTypes = RegistryState
  { forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> HashMap reqTypes (Registry n b)
rs_registry :: !(HM.HashMap reqTypes (Registry n b)),
    forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> Registry n b
rs_anyMethod :: !(Registry n b),
    forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> SlashPolicy
rs_slashPolicy :: !SlashPolicy
  }

hookAny ::
  (Monad m, Eq reqTypes, Hashable reqTypes) =>
  reqTypes ->
  ([T.Text] -> n b) ->
  RegistryT n b middleware reqTypes m ()
hookAny :: forall (m :: * -> *) reqTypes (n :: * -> *) b middleware.
(Monad m, Eq reqTypes, Hashable reqTypes) =>
reqTypes
-> ([Text] -> n b) -> RegistryT n b middleware reqTypes m ()
hookAny reqTypes
reqType [Text] -> n b
action =
  (RegistryState n b reqTypes -> RegistryState n b reqTypes)
-> RegistryT n b middleware reqTypes m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RegistryState n b reqTypes -> RegistryState n b reqTypes)
 -> RegistryT n b middleware reqTypes m ())
-> (RegistryState n b reqTypes -> RegistryState n b reqTypes)
-> RegistryT n b middleware reqTypes m ()
forall a b. (a -> b) -> a -> b
$ \RegistryState n b reqTypes
rs ->
    RegistryState n b reqTypes
rs
      { rs_registry =
          let reg = (PathMap (n b), [[Text] -> n b])
-> Maybe (PathMap (n b), [[Text] -> n b])
-> (PathMap (n b), [[Text] -> n b])
forall a. a -> Maybe a -> a
fromMaybe (PathMap (n b), [[Text] -> n b])
forall (m :: * -> *) a. Registry m a
emptyRegistry (reqTypes
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
-> Maybe (PathMap (n b), [[Text] -> n b])
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HM.lookup reqTypes
reqType (RegistryState n b reqTypes
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> HashMap reqTypes (Registry n b)
rs_registry RegistryState n b reqTypes
rs))
           in HM.insert reqType (fallbackRoute action reg) (rs_registry rs)
      }

hookAnyMethod ::
  (Monad m) =>
  ([T.Text] -> n b) ->
  RegistryT n b middleware reqTypes m ()
hookAnyMethod :: forall (m :: * -> *) (n :: * -> *) b middleware reqTypes.
Monad m =>
([Text] -> n b) -> RegistryT n b middleware reqTypes m ()
hookAnyMethod [Text] -> n b
action =
  (RegistryState n b reqTypes -> RegistryState n b reqTypes)
-> RegistryT n b middleware reqTypes m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RegistryState n b reqTypes -> RegistryState n b reqTypes)
 -> RegistryT n b middleware reqTypes m ())
-> (RegistryState n b reqTypes -> RegistryState n b reqTypes)
-> RegistryT n b middleware reqTypes m ()
forall a b. (a -> b) -> a -> b
$
    \RegistryState n b reqTypes
rs ->
      RegistryState n b reqTypes
rs
        { rs_anyMethod = fallbackRoute action (rs_anyMethod rs)
        }

hookRoute ::
  (Monad m, Eq reqTypes, Hashable reqTypes) =>
  reqTypes ->
  PathInternal as ->
  HVectElim' (n b) as ->
  RegistryT n b middleware reqTypes m ()
hookRoute :: forall (m :: * -> *) reqTypes (as :: [*]) (n :: * -> *) b
       middleware.
(Monad m, Eq reqTypes, Hashable reqTypes) =>
reqTypes
-> PathInternal as
-> HVectElim' (n b) as
-> RegistryT n b middleware reqTypes m ()
hookRoute reqTypes
reqType PathInternal as
path HVectElim' (n b) as
action =
  do
    basePath <- RegistryT n b middleware reqTypes m (PathInternal '[])
forall r (m :: * -> *). MonadReader r m => m r
ask
    modify $ \RegistryState n b reqTypes
rs ->
      RegistryState n b reqTypes
rs
        { rs_registry =
            let reg = (PathMap (n b), [[Text] -> n b])
-> Maybe (PathMap (n b), [[Text] -> n b])
-> (PathMap (n b), [[Text] -> n b])
forall a. a -> Maybe a -> a
fromMaybe (PathMap (n b), [[Text] -> n b])
forall (m :: * -> *) a. Registry m a
emptyRegistry (reqTypes
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
-> Maybe (PathMap (n b), [[Text] -> n b])
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HM.lookup reqTypes
reqType (RegistryState n b reqTypes
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> HashMap reqTypes (Registry n b)
rs_registry RegistryState n b reqTypes
rs))
                reg' = PathInternal as
-> HVectElim' (n b) as
-> (PathMap (n b), [[Text] -> n b])
-> (PathMap (n b), [[Text] -> n b])
forall (xs :: [*]) (m :: * -> *) a.
PathInternal xs
-> HVectElim' (m a) xs -> Registry m a -> Registry m a
defRoute (SlashPolicy -> PathInternal as -> PathInternal as
forall (as :: [*]).
SlashPolicy -> PathInternal as -> PathInternal as
normalizeInternalPath (RegistryState n b reqTypes -> SlashPolicy
forall (n :: * -> *) b reqTypes.
RegistryState n b reqTypes -> SlashPolicy
rs_slashPolicy RegistryState n b reqTypes
rs) (PathInternal '[]
basePath PathInternal '[] -> PathInternal as -> PathInternal (Append '[] as)
forall (as :: [*]) (bs :: [*]).
PathInternal as -> PathInternal bs -> PathInternal (Append as bs)
</!> PathInternal as
path)) HVectElim' (n b) as
action (PathMap (n b), [[Text] -> n b])
reg
             in HM.insert reqType reg' (rs_registry rs)
        }

hookRouteAnyMethod ::
  (Monad m) =>
  PathInternal as ->
  HVectElim' (n b) as ->
  RegistryT n b middleware reqTypes m ()
hookRouteAnyMethod :: forall (m :: * -> *) (as :: [*]) (n :: * -> *) b middleware
       reqTypes.
Monad m =>
PathInternal as
-> HVectElim' (n b) as -> RegistryT n b middleware reqTypes m ()
hookRouteAnyMethod PathInternal as
path HVectElim' (n b) as
action =
  do
    basePath <- RegistryT n b middleware reqTypes m (PathInternal '[])
forall r (m :: * -> *). MonadReader r m => m r
ask
    modify $ \RegistryState n b reqTypes
rs ->
      RegistryState n b reqTypes
rs
        { rs_anyMethod = defRoute (normalizeInternalPath (rs_slashPolicy rs) (basePath </!> path)) action (rs_anyMethod rs)
        }

middleware ::
  Monad m =>
  middleware ->
  RegistryT n b middleware reqTypes m ()
middleware :: forall (m :: * -> *) middleware (n :: * -> *) b reqTypes.
Monad m =>
middleware -> RegistryT n b middleware reqTypes m ()
middleware middleware
x = [middleware] -> RegistryT n b middleware reqTypes m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [middleware
x]

swapMonad ::
  Monad m =>
  (forall b. n b -> m b) ->
  RegistryT x y middleware reqTypes n a ->
  RegistryT x y middleware reqTypes m a
swapMonad :: forall (m :: * -> *) (n :: * -> *) (x :: * -> *) y middleware
       reqTypes a.
Monad m =>
(forall b. n b -> m b)
-> RegistryT x y middleware reqTypes n a
-> RegistryT x y middleware reqTypes m a
swapMonad forall b. n b -> m b
liftLower (RegistryT RWST
  (PathInternal '[]) [middleware] (RegistryState x y reqTypes) n a
subReg) =
  do
    parentSt <- RegistryT x y middleware reqTypes m (RegistryState x y reqTypes)
forall s (m :: * -> *). MonadState s m => m s
get
    basePath <- ask
    (a, parentSt', middleware') <-
      lift $ liftLower $ runRWST subReg basePath parentSt
    put parentSt'
    tell middleware'
    return a

runRegistry ::
  (Monad m, Hashable reqTypes, Eq reqTypes) =>
  RegistryT n b middleware reqTypes m a ->
  m (a, reqTypes -> [T.Text] -> [n b], [middleware])
runRegistry :: forall (m :: * -> *) reqTypes (n :: * -> *) b middleware a.
(Monad m, Hashable reqTypes, Eq reqTypes) =>
RegistryT n b middleware reqTypes m a
-> m (a, reqTypes -> [Text] -> [n b], [middleware])
runRegistry = SlashPolicy
-> RegistryT n b middleware reqTypes m a
-> m (a, reqTypes -> [Text] -> [n b], [middleware])
forall (m :: * -> *) reqTypes (n :: * -> *) b middleware a.
(Monad m, Hashable reqTypes, Eq reqTypes) =>
SlashPolicy
-> RegistryT n b middleware reqTypes m a
-> m (a, reqTypes -> [Text] -> [n b], [middleware])
runRegistryWith SlashPolicy
IgnoreSlashes

-- | Run a registry using the selected slash policy for both definitions and
-- incoming path pieces. Pass decoded pieces without the initial path separator.
runRegistryWith ::
  (Monad m, Hashable reqTypes, Eq reqTypes) =>
  SlashPolicy -> RegistryT n b middleware reqTypes m a ->
  m (a, reqTypes -> [T.Text] -> [n b], [middleware])
runRegistryWith :: forall (m :: * -> *) reqTypes (n :: * -> *) b middleware a.
(Monad m, Hashable reqTypes, Eq reqTypes) =>
SlashPolicy
-> RegistryT n b middleware reqTypes m a
-> m (a, reqTypes -> [Text] -> [n b], [middleware])
runRegistryWith SlashPolicy
policy (RegistryT RWST
  (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a
rwst) =
  do
    (val, st, w) <- RWST
  (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a
-> PathInternal '[]
-> RegistryState n b reqTypes
-> m (a, RegistryState n b reqTypes, [middleware])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST
  (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a
rwst PathInternal '[]
PI_Empty RegistryState n b reqTypes
initSt
    return (val, handleF (rs_anyMethod st) (rs_registry st), w)
  where
    handleF :: (PathMap (n b), [[Text] -> n b])
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
-> reqTypes
-> [Text]
-> [n b]
handleF (PathMap (n b), [[Text] -> n b])
anyReg HashMap reqTypes (PathMap (n b), [[Text] -> n b])
hm reqTypes
ty [Text]
route =
      let froute :: [Text]
froute = if SlashPolicy
policy SlashPolicy -> SlashPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== SlashPolicy
IgnoreSlashes then (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
route else [Text]
route
       in case reqTypes
-> HashMap reqTypes (PathMap (n b), [[Text] -> n b])
-> Maybe (PathMap (n b), [[Text] -> n b])
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HM.lookup reqTypes
ty HashMap reqTypes (PathMap (n b), [[Text] -> n b])
hm of
            Maybe (PathMap (n b), [[Text] -> n b])
Nothing -> (PathMap (n b), [[Text] -> n b]) -> [Text] -> [n b]
forall (m :: * -> *) a. Registry m a -> [Text] -> [m a]
matchRoute (PathMap (n b), [[Text] -> n b])
anyReg [Text]
froute
            Just (PathMap (n b), [[Text] -> n b])
registry ->
              ((PathMap (n b), [[Text] -> n b]) -> [Text] -> [n b]
forall (m :: * -> *) a. Registry m a -> [Text] -> [m a]
matchRoute (PathMap (n b), [[Text] -> n b])
registry [Text]
froute [n b] -> [n b] -> [n b]
forall a. [a] -> [a] -> [a]
++ (PathMap (n b), [[Text] -> n b]) -> [Text] -> [n b]
forall (m :: * -> *) a. Registry m a -> [Text] -> [m a]
matchRoute (PathMap (n b), [[Text] -> n b])
anyReg [Text]
froute)
    initSt :: RegistryState n b reqTypes
initSt =
      RegistryState
        { rs_registry :: HashMap reqTypes (PathMap (n b), [[Text] -> n b])
rs_registry = HashMap reqTypes (PathMap (n b), [[Text] -> n b])
forall k v. HashMap k v
HM.empty,
          rs_anyMethod :: (PathMap (n b), [[Text] -> n b])
rs_anyMethod = (PathMap (n b), [[Text] -> n b])
forall (m :: * -> *) a. Registry m a
emptyRegistry,
          rs_slashPolicy :: SlashPolicy
rs_slashPolicy = SlashPolicy
policy
        }