{-# 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
  { 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.
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
        }