    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TypeFamilies #-}

    module Yesod.Core.Class.Dispatch where

    import qualified Network.Wai as W
    import Yesod.Core.Types
    import Yesod.Core.Content (ToTypedContent (..))
    import Yesod.Core.Handler (sendWaiApplication)
    import Yesod.Core.Class.Yesod

    -- | This class is automatically instantiated when you use the template haskell
    -- mkYesod function. You should never need to deal with it directly.
    class Yesod site => YesodDispatch site where
        yesodDispatch :: YesodRunnerEnv site -> W.Application

    class YesodSubDispatch sub master where
        yesodSubDispatch :: YesodSubRunnerEnv sub master -> W.Application

    instance YesodSubDispatch WaiSubsite master where
        yesodSubDispatch :: YesodSubRunnerEnv WaiSubsite master -> Application
    yesodSubDispatch YesodSubRunnerEnv {YesodRunnerEnv master
    master -> WaiSubsite
    Route WaiSubsite -> Route master
    ParentRunner master
    ysreParentRunner :: ParentRunner master
    ysreGetSub :: master -> WaiSubsite
    ysreToParentRoute :: Route WaiSubsite -> Route master
    ysreParentEnv :: YesodRunnerEnv master
    ysreParentEnv :: forall sub parent.
    YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
    ysreToParentRoute :: forall sub parent.
    YesodSubRunnerEnv sub parent -> Route sub -> Route parent
    ysreGetSub :: forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
    ysreParentRunner :: forall sub parent.
    YesodSubRunnerEnv sub parent -> ParentRunner parent
    ..} = Application
    app
          where
            WaiSubsite Application
    app = master -> WaiSubsite
    ysreGetSub (master -> WaiSubsite) -> master -> WaiSubsite
    forall a b. (a -> b) -> a -> b
    $ YesodRunnerEnv master -> master
    forall site. YesodRunnerEnv site -> site
    yreSite YesodRunnerEnv master
    ysreParentEnv

    instance YesodSubDispatch WaiSubsiteWithAuth master where
      yesodSubDispatch :: YesodSubRunnerEnv WaiSubsiteWithAuth master -> Application
    yesodSubDispatch YesodSubRunnerEnv {YesodRunnerEnv master
    master -> WaiSubsiteWithAuth
    Route WaiSubsiteWithAuth -> Route master
    ParentRunner master
    ysreParentEnv :: forall sub parent.
    YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
    ysreToParentRoute :: forall sub parent.
    YesodSubRunnerEnv sub parent -> Route sub -> Route parent
    ysreGetSub :: forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
    ysreParentRunner :: forall sub parent.
    YesodSubRunnerEnv sub parent -> ParentRunner parent
    ysreParentRunner :: ParentRunner master
    ysreGetSub :: master -> WaiSubsiteWithAuth
    ysreToParentRoute :: Route WaiSubsiteWithAuth -> Route master
    ysreParentEnv :: YesodRunnerEnv master
    ..} Request
    req =
          ParentRunner master
    ysreParentRunner HandlerFor master TypedContent
    handlert YesodRunnerEnv master
    ysreParentEnv ((Route WaiSubsiteWithAuth -> Route master)
    -> Maybe (Route WaiSubsiteWithAuth) -> Maybe (Route master)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Route WaiSubsiteWithAuth -> Route master
    ysreToParentRoute Maybe (Route WaiSubsiteWithAuth)
    route) Request
    req
        where
          route :: Maybe (Route WaiSubsiteWithAuth)
    route = Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth)
    forall a. a -> Maybe a
    Just (Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth))
    -> Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth)
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [(Text, Text)] -> Route WaiSubsiteWithAuth
    WaiSubsiteWithAuthRoute (Request -> [Text]
    W.pathInfo Request
    req) []
          WaiSubsiteWithAuth Application
    set = master -> WaiSubsiteWithAuth
    ysreGetSub (master -> WaiSubsiteWithAuth) -> master -> WaiSubsiteWithAuth
    forall a b. (a -> b) -> a -> b
    $ YesodRunnerEnv master -> master
    forall site. YesodRunnerEnv site -> site
    yreSite (YesodRunnerEnv master -> master)
    -> YesodRunnerEnv master -> master
    forall a b. (a -> b) -> a -> b
    $ YesodRunnerEnv master
    ysreParentEnv
          handlert :: HandlerFor master TypedContent
    handlert = Application -> HandlerFor master TypedContent
    forall (m :: * -> *) b. MonadHandler m => Application -> m b
    sendWaiApplication Application
    set

    subHelper
      :: ToTypedContent content
      => SubHandlerFor child master content
      -> YesodSubRunnerEnv child master
      -> Maybe (Route child)
      -> W.Application
    subHelper :: forall content child master.
    ToTypedContent content =>
    SubHandlerFor child master content
    -> YesodSubRunnerEnv child master
    -> Maybe (Route child)
    -> Application
    subHelper (SubHandlerFor HandlerData child master -> IO content
    f) YesodSubRunnerEnv {YesodRunnerEnv master
    master -> child
    Route child -> Route master
    ParentRunner master
    ysreParentEnv :: forall sub parent.
    YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
    ysreToParentRoute :: forall sub parent.
    YesodSubRunnerEnv sub parent -> Route sub -> Route parent
    ysreGetSub :: forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
    ysreParentRunner :: forall sub parent.
    YesodSubRunnerEnv sub parent -> ParentRunner parent
    ysreParentRunner :: ParentRunner master
    ysreGetSub :: master -> child
    ysreToParentRoute :: Route child -> Route master
    ysreParentEnv :: YesodRunnerEnv master
    ..} Maybe (Route child)
    mroute =
        ParentRunner master
    ysreParentRunner HandlerFor master TypedContent
    handler YesodRunnerEnv master
    ysreParentEnv ((Route child -> Route master)
    -> Maybe (Route child) -> Maybe (Route master)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Route child -> Route master
    ysreToParentRoute Maybe (Route child)
    mroute)
      where
        handler :: HandlerFor master TypedContent
    handler = (content -> TypedContent)
    -> HandlerFor master content -> HandlerFor master TypedContent
    forall a b. (a -> b) -> HandlerFor master a -> HandlerFor master b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap content -> TypedContent
    forall a. ToTypedContent a => a -> TypedContent
    toTypedContent (HandlerFor master content -> HandlerFor master TypedContent)
    -> HandlerFor master content -> HandlerFor master TypedContent
    forall a b. (a -> b) -> a -> b
    $ (HandlerData master master -> IO content)
    -> HandlerFor master content
    forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
    HandlerFor ((HandlerData master master -> IO content)
     -> HandlerFor master content)
    -> (HandlerData master master -> IO content)
    -> HandlerFor master content
    forall a b. (a -> b) -> a -> b
    $ \HandlerData master master
    hd ->
          let rhe :: RunHandlerEnv master master
    rhe = HandlerData master master -> RunHandlerEnv master master
    forall child site.
    HandlerData child site -> RunHandlerEnv child site
    handlerEnv HandlerData master master
    hd
              rhe' :: RunHandlerEnv child master
    rhe' = RunHandlerEnv master master
    rhe
                { rheRoute = mroute
                , rheChild = ysreGetSub $ yreSite ysreParentEnv
                , rheRouteToMaster = ysreToParentRoute
                }
           in HandlerData child master -> IO content
    f HandlerData master master
    hd { handlerEnv = rhe' }