{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} module Web.Routing.Router where import Web.Routing.SafeRouting #if MIN_VERSION_base(4,8,0) #else import Control.Applicative #endif import Control.Monad.RWS.Strict import Data.Hashable import Data.Maybe import qualified Data.HashMap.Strict as HM import qualified Data.Text as T newtype RegistryT n b middleware reqTypes (m :: * -> *) a = RegistryT { 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) a -> RegistryT n b middleware reqTypes m a 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) RegistryT n b middleware reqTypes m a -> (a -> RegistryT n b middleware reqTypes m b) -> RegistryT n b middleware reqTypes m 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 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 return :: a -> RegistryT n b middleware reqTypes m a $creturn :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a. Monad m => a -> RegistryT n b middleware reqTypes m a >> :: 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 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 -> (a -> RegistryT n b middleware reqTypes m b) -> RegistryT n b middleware reqTypes m b $cp1Monad :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *). Monad m => Applicative (RegistryT n b middleware reqTypes m) Monad, a -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m a (a -> b) -> RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b (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 <$ :: a -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m a $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 fmap :: (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 Functor, Functor (RegistryT n b middleware reqTypes m) a -> RegistryT n b middleware reqTypes m a 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) RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m b RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m a RegistryT n b middleware reqTypes m (a -> b) -> RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b (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. 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 <* :: RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b -> 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 -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m a *> :: 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 b liftA2 :: (a -> b -> c) -> RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b -> RegistryT n b middleware reqTypes m c $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 <*> :: RegistryT n b middleware reqTypes m (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. Monad m => RegistryT n b middleware reqTypes m (a -> b) -> RegistryT n b middleware reqTypes m a -> RegistryT n b middleware reqTypes m b pure :: a -> RegistryT n b middleware reqTypes m a $cpure :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a. Monad m => a -> RegistryT n b middleware reqTypes m a $cp1Applicative :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *). Monad m => Functor (RegistryT n b middleware reqTypes m) 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) IO a -> RegistryT n b middleware reqTypes m a 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 liftIO :: 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 $cp1MonadIO :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *). MonadIO m => Monad (RegistryT n b middleware reqTypes m) MonadIO , MonadReader (PathInternal '[]) , MonadWriter [middleware] , MonadState (RegistryState n b reqTypes) , m a -> RegistryT n b middleware reqTypes m a (forall (m :: * -> *) a. Monad m => m a -> RegistryT n b middleware reqTypes m a) -> MonadTrans (RegistryT n b middleware reqTypes) forall (m :: * -> *) a. Monad m => m a -> RegistryT n b middleware reqTypes m a forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a. Monad m => m a -> RegistryT n b middleware reqTypes m a forall (t :: (* -> *) -> * -> *). (forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t lift :: m a -> RegistryT n b middleware reqTypes m a $clift :: forall (n :: * -> *) b middleware reqTypes (m :: * -> *) a. Monad m => m a -> RegistryT n b middleware reqTypes m a MonadTrans ) data RegistryState n b reqTypes = RegistryState { RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry :: !(HM.HashMap reqTypes (Registry n b)) , RegistryState n b reqTypes -> Registry n b rs_anyMethod :: !(Registry n b) } hookAny :: (Monad m, Eq reqTypes, Hashable reqTypes) => reqTypes -> ([T.Text] -> n b) -> RegistryT n b middleware reqTypes m () hookAny :: 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 :: HashMap reqTypes (Registry n b) rs_registry = let reg :: Registry n b reg = Registry n b -> Maybe (Registry n b) -> Registry n b forall a. a -> Maybe a -> a fromMaybe Registry n b forall (m :: * -> *) a. Registry m a emptyRegistry (reqTypes -> HashMap reqTypes (Registry n b) -> Maybe (Registry n b) forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup reqTypes reqType (RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry RegistryState n b reqTypes rs)) in reqTypes -> Registry n b -> HashMap reqTypes (Registry n b) -> HashMap reqTypes (Registry n b) forall k v. (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v HM.insert reqTypes reqType (([Text] -> n b) -> Registry n b -> Registry n b forall (m :: * -> *) a. ([Text] -> m a) -> Registry m a -> Registry m a fallbackRoute [Text] -> n b action Registry n b reg) (RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry RegistryState n b reqTypes rs) } hookAnyMethod :: (Monad m) => ([T.Text] -> n b) -> RegistryT n b middleware reqTypes m () hookAnyMethod :: ([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 :: Registry n b rs_anyMethod = ([Text] -> n b) -> Registry n b -> Registry n b forall (m :: * -> *) a. ([Text] -> m a) -> Registry m a -> Registry m a fallbackRoute [Text] -> n b action (RegistryState n b reqTypes -> Registry n b forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> Registry n b rs_anyMethod RegistryState n b reqTypes rs) } hookRoute :: (Monad m, Eq reqTypes, Hashable reqTypes) => reqTypes -> PathInternal as -> HVectElim' (n b) as -> RegistryT n b middleware reqTypes m () hookRoute :: 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 PathInternal '[] basePath <- RegistryT n b middleware reqTypes m (PathInternal '[]) forall r (m :: * -> *). MonadReader r m => m r ask (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 :: HashMap reqTypes (Registry n b) rs_registry = let reg :: Registry n b reg = Registry n b -> Maybe (Registry n b) -> Registry n b forall a. a -> Maybe a -> a fromMaybe Registry n b forall (m :: * -> *) a. Registry m a emptyRegistry (reqTypes -> HashMap reqTypes (Registry n b) -> Maybe (Registry n b) forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup reqTypes reqType (RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry RegistryState n b reqTypes rs)) reg' :: Registry n b reg' = PathInternal as -> HVectElim' (n b) as -> Registry n b -> Registry n b forall (xs :: [*]) (m :: * -> *) a. PathInternal xs -> HVectElim' (m a) xs -> Registry m a -> Registry m a defRoute (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 Registry n b reg in reqTypes -> Registry n b -> HashMap reqTypes (Registry n b) -> HashMap reqTypes (Registry n b) forall k v. (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v HM.insert reqTypes reqType Registry n b reg' (RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry RegistryState n b reqTypes rs) } hookRouteAnyMethod :: (Monad m) => PathInternal as -> HVectElim' (n b) as -> RegistryT n b middleware reqTypes m () hookRouteAnyMethod :: PathInternal as -> HVectElim' (n b) as -> RegistryT n b middleware reqTypes m () hookRouteAnyMethod PathInternal as path HVectElim' (n b) as action = do PathInternal '[] basePath <- RegistryT n b middleware reqTypes m (PathInternal '[]) forall r (m :: * -> *). MonadReader r m => m r ask (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 :: Registry n b rs_anyMethod = PathInternal as -> HVectElim' (n b) as -> Registry n b -> Registry n b forall (xs :: [*]) (m :: * -> *) a. PathInternal xs -> HVectElim' (m a) xs -> Registry m a -> Registry m a defRoute (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 (RegistryState n b reqTypes -> Registry n b forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> Registry n b rs_anyMethod RegistryState n b reqTypes rs) } middleware :: Monad m => middleware -> RegistryT n b middleware reqTypes m () middleware :: 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 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 RegistryState x y reqTypes parentSt <- RegistryT x y middleware reqTypes m (RegistryState x y reqTypes) forall s (m :: * -> *). MonadState s m => m s get PathInternal '[] basePath <- RegistryT x y middleware reqTypes m (PathInternal '[]) forall r (m :: * -> *). MonadReader r m => m r ask (a a, RegistryState x y reqTypes parentSt', [middleware] middleware') <- m (a, RegistryState x y reqTypes, [middleware]) -> RegistryT x y middleware reqTypes m (a, RegistryState x y reqTypes, [middleware]) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m (a, RegistryState x y reqTypes, [middleware]) -> RegistryT x y middleware reqTypes m (a, RegistryState x y reqTypes, [middleware])) -> m (a, RegistryState x y reqTypes, [middleware]) -> RegistryT x y middleware reqTypes m (a, RegistryState x y reqTypes, [middleware]) forall a b. (a -> b) -> a -> b $ n (a, RegistryState x y reqTypes, [middleware]) -> m (a, RegistryState x y reqTypes, [middleware]) forall b. n b -> m b liftLower (n (a, RegistryState x y reqTypes, [middleware]) -> m (a, RegistryState x y reqTypes, [middleware])) -> n (a, RegistryState x y reqTypes, [middleware]) -> m (a, RegistryState x y reqTypes, [middleware]) forall a b. (a -> b) -> a -> b $ RWST (PathInternal '[]) [middleware] (RegistryState x y reqTypes) n a -> PathInternal '[] -> RegistryState x y reqTypes -> n (a, RegistryState x y 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 x y reqTypes) n a subReg PathInternal '[] basePath RegistryState x y reqTypes parentSt RegistryState x y reqTypes -> RegistryT x y middleware reqTypes m () forall s (m :: * -> *). MonadState s m => s -> m () put RegistryState x y reqTypes parentSt' [middleware] -> RegistryT x y middleware reqTypes m () forall w (m :: * -> *). MonadWriter w m => w -> m () tell [middleware] middleware' a -> RegistryT x y middleware reqTypes m a forall (m :: * -> *) a. Monad m => a -> m a return a a runRegistry :: (Monad m, Hashable reqTypes, Eq reqTypes) => RegistryT n b middleware reqTypes m a -> m (a, reqTypes -> [T.Text] -> [n b], [middleware]) runRegistry :: RegistryT n b middleware reqTypes m a -> m (a, reqTypes -> [Text] -> [n b], [middleware]) runRegistry (RegistryT RWST (PathInternal '[]) [middleware] (RegistryState n b reqTypes) m a rwst) = do (a val, RegistryState n b reqTypes st, [middleware] 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 forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes initSt (a, reqTypes -> [Text] -> [n b], [middleware]) -> m (a, reqTypes -> [Text] -> [n b], [middleware]) forall (m :: * -> *) a. Monad m => a -> m a return (a val, Registry n b -> HashMap reqTypes (Registry n b) -> reqTypes -> [Text] -> [n b] forall k (m :: * -> *) a. (Eq k, Hashable k) => Registry m a -> HashMap k (Registry m a) -> k -> [Text] -> [m a] handleF (RegistryState n b reqTypes -> Registry n b forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> Registry n b rs_anyMethod RegistryState n b reqTypes st) (RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) forall (n :: * -> *) b reqTypes. RegistryState n b reqTypes -> HashMap reqTypes (Registry n b) rs_registry RegistryState n b reqTypes st), [middleware] w) where handleF :: Registry m a -> HashMap k (Registry m a) -> k -> [Text] -> [m a] handleF Registry m a anyReg HashMap k (Registry m a) hm k ty [Text] route = let froute :: [Text] froute = (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 in case k -> HashMap k (Registry m a) -> Maybe (Registry m a) forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup k ty HashMap k (Registry m a) hm of Maybe (Registry m a) Nothing -> Registry m a -> [Text] -> [m a] forall (m :: * -> *) a. Registry m a -> [Text] -> [m a] matchRoute Registry m a anyReg [Text] froute Just Registry m a registry -> (Registry m a -> [Text] -> [m a] forall (m :: * -> *) a. Registry m a -> [Text] -> [m a] matchRoute Registry m a registry [Text] froute [m a] -> [m a] -> [m a] forall a. [a] -> [a] -> [a] ++ Registry m a -> [Text] -> [m a] forall (m :: * -> *) a. Registry m a -> [Text] -> [m a] matchRoute Registry m a anyReg [Text] froute) initSt :: RegistryState n b reqTypes initSt = RegistryState :: forall (n :: * -> *) b reqTypes. HashMap reqTypes (Registry n b) -> Registry n b -> RegistryState n b reqTypes RegistryState { rs_registry :: HashMap reqTypes (Registry n b) rs_registry = HashMap reqTypes (Registry n b) forall k v. HashMap k v HM.empty , rs_anyMethod :: Registry n b rs_anyMethod = Registry n b forall (m :: * -> *) a. Registry m a emptyRegistry }