Simplify YesodSubDispatch

yesod-auth/Yesod/Auth.hs

@@ -582,8 +582,7 @@ data AuthException = InvalidFacebookResponse
     deriving (Show, Typeable)
 instance Exception AuthException
 
--- FIXME HandlerSite m ~ SubHandlerSite m should be unnecessary
+instance YesodAuth master => YesodSubDispatch Auth master where
-instance (YesodAuth (HandlerSite m), HandlerSite m ~ SubHandlerSite m, MonadSubHandler m, MonadUnliftIO m) => YesodSubDispatch Auth m where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)
 
 asHtml :: Html -> Html

yesod-core/Yesod/Core/Class/Dispatch.hs

@@ -19,16 +19,15 @@ import Control.Monad.Trans.Reader (ReaderT (..), ask)
 class Yesod site => YesodDispatch site where
     yesodDispatch :: YesodRunnerEnv site -> W.Application
 
-class YesodSubDispatch sub m where
+class YesodSubDispatch sub master where
-    yesodSubDispatch :: YesodSubRunnerEnv sub (HandlerSite m) m
+    yesodSubDispatch :: YesodSubRunnerEnv sub master -> W.Application
-                     -> W.Application
 
 instance YesodSubDispatch WaiSubsite master where
     yesodSubDispatch YesodSubRunnerEnv {..} = app
       where
         WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
 
-instance MonadHandler m => YesodSubDispatch WaiSubsiteWithAuth m where
+instance YesodSubDispatch WaiSubsiteWithAuth master where
   yesodSubDispatch YesodSubRunnerEnv {..} req =
       ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
     where
@@ -90,9 +89,9 @@ instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (Read
       }
 
 subHelper
-  :: (ToTypedContent content, MonadSubHandler m, master ~ HandlerSite m, parent ~ SubHandlerSite m)
+  :: ToTypedContent content
-  => ReaderT (SubsiteData child master) m content
+  => ReaderT (SubsiteData child master) (HandlerFor master) content
-  -> YesodSubRunnerEnv child parent m
+  -> YesodSubRunnerEnv child master
   -> Maybe (Route child)
   -> W.Application
 subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
@@ -100,7 +99,7 @@ subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
   where
     handler = fmap toTypedContent $ do
       tm <- getRouteToParent
-      f SubsiteData
+      liftHandler $ f SubsiteData
         { sdRouteToParent = tm . ysreToParentRoute
         , sdCurrentRoute = mroute
         , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv

yesod-core/Yesod/Core/Types.hs

@@ -203,15 +203,15 @@ data YesodRunnerEnv site = YesodRunnerEnv
     , yreGetMaxExpires  :: IO Text
     }
 
-data YesodSubRunnerEnv sub parent parentMonad = YesodSubRunnerEnv
+data YesodSubRunnerEnv sub parent = YesodSubRunnerEnv
-    { ysreParentRunner  :: !(ParentRunner parent parentMonad)
+    { ysreParentRunner  :: !(ParentRunner parent)
     , ysreGetSub        :: !(parent -> sub)
     , ysreToParentRoute :: !(Route sub -> Route parent)
     , ysreParentEnv     :: !(YesodRunnerEnv parent) -- FIXME maybe get rid of this and remove YesodRunnerEnv in ParentRunner?
     }
 
-type ParentRunner parent m
+type ParentRunner parent
-    = m TypedContent
+    = HandlerFor parent TypedContent
    -> YesodRunnerEnv parent
    -> Maybe (Route parent)
    -> W.Application

yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs

@@ -10,7 +10,7 @@ module YesodCoreTest.NoOverloadedStringsSub where
 import Yesod.Core
 import Yesod.Core.Types
 
-data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerFor master) -> Application)
+data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master -> Application)
 
 mkYesodSubData "Subsite" [parseRoutes|
 /bar BarR GET
@@ -21,7 +21,7 @@ mkYesodSubData "Subsite" [parseRoutes|
 /has-three-pieces/#Int/#Int/#Int ThreePiecesR GET
 |]
 
-instance Yesod master => YesodSubDispatch Subsite (HandlerFor master) where
+instance Yesod master => YesodSubDispatch Subsite master where
     yesodSubDispatch ysre =
         f ysre
       where

yesod-static/Yesod/EmbeddedStatic.hs

@@ -81,7 +81,7 @@ import Yesod.EmbeddedStatic.Generators
 embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic
 embeddedResourceR = EmbeddedResourceR
 
-instance YesodSubDispatch EmbeddedStatic (HandlerT master IO) where
+instance YesodSubDispatch EmbeddedStatic master where
     yesodSubDispatch YesodSubRunnerEnv {..} req = resp
         where
             master = yreSite ysreParentEnv

yesod-static/Yesod/Static.hs

@@ -171,7 +171,7 @@ instance RenderRoute Static where
 instance ParseRoute Static where
     parseRoute (x, y) = Just $ StaticRoute x y
 
-instance MonadHandler m => YesodSubDispatch Static m where
+instance YesodSubDispatch Static master where
     yesodSubDispatch YesodSubRunnerEnv {..} req =
         ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
       where