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