module Yesod.Core.Class.Dispatch where
import Yesod.Routes.Class
import qualified Network.Wai as W
import Yesod.Core.Types
import Yesod.Core.Content
import Yesod.Core.Handler (stripHandlerT)
import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Handler
class Yesod site => YesodDispatch site where
yesodDispatch :: YesodRunnerEnv site -> W.Application
class YesodSubDispatch sub m where
yesodSubDispatch :: YesodSubRunnerEnv sub (HandlerSite m) m
-> W.Application
instance YesodSubDispatch WaiSubsite master where
yesodSubDispatch YesodSubRunnerEnv {..} = app
where
WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
subHelper :: Monad m
=> HandlerT child (HandlerT parent m) TypedContent
-> YesodSubRunnerEnv child parent (HandlerT parent m)
-> Maybe (Route child)
-> W.Application
subHelper handlert YesodSubRunnerEnv {..} route =
ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route)
where
base = stripHandlerT (fmap toTypedContent handlert) ysreGetSub ysreToParentRoute route