remove runSubHandler, using modified version of toMasterHandler instead

Yesod/Handler.hs

@@ -48,8 +48,6 @@ module Yesod.Handler
       -- ** Short-circuit responses.
     , sendFile
     , sendResponse
-      -- ** Calling foreign subsite handlers
-    , runSubHandler
       -- * Setting headers
     , setCookie
     , deleteCookie
@@ -78,6 +76,7 @@ module Yesod.Handler
     , runHandler
     , YesodApp (..)
     , toMasterHandler
+    , toMasterHandlerMaybe
     , localNoCurrent
     , HandlerData
     , ErrorResponse (..)
@@ -142,10 +141,17 @@ handlerSubData :: (Route sub -> Route master)
                -> Route sub
                -> HandlerData oldSub master
                -> HandlerData sub master
-handlerSubData tm ts route hd = hd
+handlerSubData tm ts = handlerSubDataMaybe tm ts . Just
+
+handlerSubDataMaybe :: (Route sub -> Route master)
+                    -> (master -> sub)
+                    -> Maybe (Route sub)
+                    -> HandlerData oldSub master
+                    -> HandlerData sub master
+handlerSubDataMaybe tm ts route hd = hd
     { handlerSub = ts $ handlerMaster hd
     , handlerToMaster = tm
-    , handlerRoute = Just route
+    , handlerRoute = route
     }
 
 -- | Used internally for promoting subsite handler functions to master site
@@ -154,10 +160,18 @@ toMasterHandler :: (Route sub -> Route master)
                 -> (master -> sub)
                 -> Route sub
                 -> GHandler sub master a
-                -> GHandler master master a
+                -> GHandler sub' master a
 toMasterHandler tm ts route (GHandler h) =
     GHandler $ withReaderT (handlerSubData tm ts route) h
 
+toMasterHandlerMaybe :: (Route sub -> Route master)
+                     -> (master -> sub)
+                     -> Maybe (Route sub)
+                     -> GHandler sub master a
+                     -> GHandler sub' master a
+toMasterHandlerMaybe tm ts route (GHandler h) =
+    GHandler $ withReaderT (handlerSubDataMaybe tm ts route) h
+
 -- | A generic handler monad, which can have a different subsite and master
 -- site. This monad is a combination of 'ReaderT' for basic arguments, a
 -- 'WriterT' for headers and session, and an 'MEitherT' monad for handling
@@ -217,28 +231,6 @@ instance RequestReader (GHandler sub master) where
 getYesodSub :: GHandler sub master sub
 getYesodSub = handlerSub <$> GHandler ask
 
--- | Set the subsite in HandlerData
-setHandlerSub :: YesodSubRoute sub' master => sub' -> HandlerData sub master -> HandlerData sub' master
-setHandlerSub s (HandlerData r _ m _ rn _) = HandlerData r s m Nothing rn $ fromSubRoute s m
-
--- | Run a handler from another subsite
-runSubHandler :: YesodSubRoute sub' master => sub' -> GHandler sub' master a -> GHandler sub master a
-runSubHandler sub handler = do 
-  hd <- setHandlerSub sub <$> GHandler ask
-  session <- getSession
-  GHandler $ do
-    let toErrorHandler =
-            InternalError
-            . (show :: Control.Exception.SomeException -> String)
-    ((contents, headers), finalSession) <- liftIO $ flip runStateT session
-                       $ runWriterT
-                       $ runMEitherT
-                       $ flip runReaderT hd
-                       $ unGHandler handler
-    lift $ lift $ lift $ put finalSession
-    lift $ MEitherT $ return contents
-
-
 -- | Get the master site appliation argument.
 getYesod :: GHandler sub master master
 getYesod = handlerMaster <$> GHandler ask

Yesod/Widget.hs

@@ -40,7 +40,7 @@ import Control.Monad.Trans.State
 import Text.Hamlet
 import Text.Cassius
 import Text.Julius
-import Yesod.Handler (Route, GHandler, HandlerData, YesodSubRoute, runSubHandler)
+import Yesod.Handler (Route, GHandler, HandlerData, YesodSubRoute(..), toMasterHandlerMaybe, getYesod)
 import Control.Applicative (Applicative)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Trans.Class (lift)
@@ -98,32 +98,32 @@ liftHandler :: GHandler sub master a -> GWidget sub master a
 liftHandler = GWidget . lift . lift . lift . lift . lift . lift . lift . lift
 
 addSubWidget :: (YesodSubRoute sub master) => sub -> GWidget sub master a -> GWidget sub' master a
-addSubWidget sub w = do
+addSubWidget sub w = do master <- liftHandler getYesod
-                       i <- GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift get
+                        let sr = fromSubRoute sub master
-                       w' <- liftHandler $ runSubHandler sub $ flip runStateT i
+                        i <- GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift get
-                             $ runWriterT $ runWriterT $ runWriterT $ runWriterT
+                        w' <- liftHandler $ toMasterHandlerMaybe sr (const sub) Nothing $ flip runStateT i
-                             $ runWriterT $ runWriterT $ runWriterT 
+                              $ runWriterT $ runWriterT $ runWriterT $ runWriterT
-                             $ unGWidget w
+                              $ runWriterT $ runWriterT $ runWriterT 
-                       let ((((((((a,
+                              $ unGWidget w
-                                   body),
+                        let ((((((((a,
-                                  title),
+                                    body),
-                                 scripts),
+                                   title),
-                                stylesheets),
+                                  scripts),
-                               style),
+                                 stylesheets),
-                              jscript),
+                                style),
-                             h),
+                               jscript),
-                            i') = w'
+                              h),
-                       GWidget $ do
+                             i') = w'
-                         tell body
+                        GWidget $ do
-                         lift $ tell title
+                          tell body
-                         lift $ lift $ tell scripts
+                          lift $ tell title
-                         lift $ lift $ lift $ tell stylesheets
+                          lift $ lift $ tell scripts
-                         lift $ lift $ lift $ lift $ tell style
+                          lift $ lift $ lift $ tell stylesheets
-                         lift $ lift $ lift $ lift $ lift $ tell jscript
+                          lift $ lift $ lift $ lift $ tell style
-                         lift $ lift $ lift $ lift $ lift $ lift $ tell h
+                          lift $ lift $ lift $ lift $ lift $ tell jscript
-                         lift $ lift $ lift $ lift $ lift $ lift $ lift $ put i'
+                          lift $ lift $ lift $ lift $ lift $ lift $ tell h
-                         return a
+                          lift $ lift $ lift $ lift $ lift $ lift $ lift $ put i'
-                                     
+                          return a
 
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.