From 47ee7384ea123135d090c4e931657cb11c583b94 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 13 Dec 2017 09:53:14 +0200
Subject: [PATCH] Be gone with ye HandlerT!

---
 yesod-core/ChangeLog.md                       |   4 +
 yesod-core/Yesod/Core.hs                      |  14 +-
 yesod-core/Yesod/Core/Class/Breadcrumbs.hs    |   4 +-
 yesod-core/Yesod/Core/Class/Dispatch.hs       |  77 ++++--
 yesod-core/Yesod/Core/Class/Handler.hs        |  48 ++--
 yesod-core/Yesod/Core/Class/Yesod.hs          |  64 ++---
 yesod-core/Yesod/Core/Dispatch.hs             |   1 -
 yesod-core/Yesod/Core/Handler.hs              |  57 ++---
 yesod-core/Yesod/Core/Internal/LiteApp.hs     |   4 +-
 yesod-core/Yesod/Core/Internal/Run.hs         |  11 +-
 yesod-core/Yesod/Core/Internal/TH.hs          |   9 +-
 yesod-core/Yesod/Core/Json.hs                 |  10 +-
 yesod-core/Yesod/Core/Types.hs                | 226 ++++++++----------
 yesod-core/Yesod/Core/Unsafe.hs               |   5 +-
 yesod-core/Yesod/Core/Widget.hs               |  56 +----
 .../test/YesodCoreTest/NoOverloadedStrings.hs |  15 +-
 .../YesodCoreTest/NoOverloadedStringsSub.hs   |   4 +-
 17 files changed, 290 insertions(+), 319 deletions(-)

diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md
index 88a0dcb2..521e68fc 100644
--- a/yesod-core/ChangeLog.md
+++ b/yesod-core/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.5.0
+
+* Overhaul of `HandlerT`/`WidgetT` to no longer be transformers.
+
 ## 1.4.38
 
 * Internal only change, users of stable API are unaffected: `WidgetT`
diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs
index 1d5de1d1..d13d5cf4 100644
--- a/yesod-core/Yesod/Core.hs
+++ b/yesod-core/Yesod/Core.hs
@@ -67,15 +67,15 @@ module Yesod.Core
     -- * JS loaders
     , ScriptLoadPosition (..)
     , BottomOfHeadAsync
-      -- * Subsites
+    -- * Generalizing type classes
     , MonadHandler (..)
     , MonadWidget (..)
-    , getRouteToParent
-    , defaultLayoutSub
       -- * Approot
     , guessApproot
     , guessApprootOr
     , getApprootText
+      -- * Subsites
+    , MonadSubHandler (..)
       -- * Misc
     , yesodVersion
     , yesodRender
@@ -185,14 +185,6 @@ maybeAuthorized r isWrite = do
     x <- isAuthorized r isWrite
     return $ if x == Authorized then Just r else Nothing
 
-getRouteToParent :: Monad m => HandlerT child (HandlerT parent m) (Route child -> Route parent)
-getRouteToParent = HandlerT $ return . handlerToParent
-
-defaultLayoutSub :: Yesod parent
-                 => WidgetT child IO ()
-                 -> HandlerT child (HandlerT parent IO) Html
-defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout
-
 showIntegral :: Integral a => a -> String
 showIntegral x = show (fromIntegral x :: Integer)
 
diff --git a/yesod-core/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
index 84586055..1e956ff2 100644
--- a/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
+++ b/yesod-core/Yesod/Core/Class/Breadcrumbs.hs
@@ -11,11 +11,11 @@ import Data.Text (Text)
 class YesodBreadcrumbs site where
     -- | Returns the title and the parent resource, if available. If you return
     -- a 'Nothing', then this is considered a top-level page.
-    breadcrumb :: Route site -> HandlerT site IO (Text , Maybe (Route site))
+    breadcrumb :: Route site -> HandlerFor site (Text , Maybe (Route site))
 
 -- | Gets the title of the current page and the hierarchy of parent pages,
 -- along with their respective titles.
-breadcrumbs :: YesodBreadcrumbs site => HandlerT site IO (Text, [(Route site, Text)])
+breadcrumbs :: YesodBreadcrumbs site => HandlerFor site (Text, [(Route site, Text)])
 breadcrumbs = do
     x <- getCurrentRoute
     case x of
diff --git a/yesod-core/Yesod/Core/Class/Dispatch.hs b/yesod-core/Yesod/Core/Class/Dispatch.hs
index b68340ea..16910ecf 100644
--- a/yesod-core/Yesod/Core/Class/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Class/Dispatch.hs
@@ -6,13 +6,13 @@
 {-# LANGUAGE FlexibleContexts  #-}
 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 (sendWaiApplication, stripHandlerT)
-import Yesod.Core.Class.Yesod
+import Yesod.Core.Content (ToTypedContent (..))
+import Yesod.Core.Handler (sendWaiApplication, getYesod, getCurrentRoute)
 import Yesod.Core.Class.Handler
+import Yesod.Core.Class.Yesod
+import Control.Monad.Trans.Reader (ReaderT (..), ask)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -28,24 +28,63 @@ instance YesodSubDispatch WaiSubsite master where
       where
         WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
 
-instance YesodSubDispatch WaiSubsiteWithAuth (HandlerT master IO) where
+instance MonadHandler m => YesodSubDispatch WaiSubsiteWithAuth m where
   yesodSubDispatch YesodSubRunnerEnv {..} req =
-      ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
+      ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
     where
-      base  = stripHandlerT handlert ysreGetSub ysreToParentRoute route
       route = Just $ WaiSubsiteWithAuthRoute (W.pathInfo req) []
       WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
-      handlert = sendWaiApplication $ set
+      handlert = sendWaiApplication set
 
--- | A helper function for creating YesodSubDispatch instances, used by the
--- internal generated code. This function has been exported since 1.4.11.
--- It promotes a subsite handler to a wai application.
-subHelper :: Monad m -- NOTE: This is incredibly similar in type signature to yesodRunner, should probably be pointed out/explained.
-          => 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)
+type SubHandler child parent a = ReaderT (SubsiteData child parent) (HandlerFor parent) a
+
+data SubsiteData child parent = SubsiteData
+  { sdToParentRoute :: !(Route child -> Route parent)
+  , sdCurrentRoute :: !(Maybe (Route child))
+  , sdSubsiteData :: !child
+  }
+
+class MonadHandler m => MonadSubHandler m where
+  type SubHandlerSite m
+
+  getSubYesod :: m (SubHandlerSite m)
+  getToParentRoute :: m (Route (SubHandlerSite m) -> Route (HandlerSite m))
+  getSubCurrentRoute :: m (Maybe (Route (SubHandlerSite m)))
+
+instance MonadSubHandler (HandlerFor site) where
+  type SubHandlerSite (HandlerFor site) = site
+
+  getSubYesod = getYesod
+  getToParentRoute = return id
+  getSubCurrentRoute = getCurrentRoute
+
+instance MonadSubHandler (WidgetFor site) where
+  type SubHandlerSite (WidgetFor site) = site
+
+  getSubYesod = getYesod
+  getToParentRoute = return id
+  getSubCurrentRoute = getCurrentRoute
+
+instance (MonadSubHandler m, parent ~ SubHandlerSite m) => MonadSubHandler (ReaderT (SubsiteData child parent) m) where
+  type SubHandlerSite (ReaderT (SubsiteData child parent) m) = child
+
+  getSubYesod = fmap sdSubsiteData ask
+  getSubCurrentRoute = fmap sdCurrentRoute ask
+  getToParentRoute = ReaderT $ \sd -> do
+    toParent' <- getToParentRoute
+    return $ toParent' . sdToParentRoute sd
+
+subHelper
+  :: (ToTypedContent content, MonadSubHandler m, parent ~ HandlerSite m)
+  => ReaderT (SubsiteData child parent) m content
+  -> YesodSubRunnerEnv child parent m
+  -> Maybe (Route child)
+  -> W.Application
+subHelper (ReaderT f) YesodSubRunnerEnv {..} mroute =
+    ysreParentRunner handler ysreParentEnv (fmap ysreToParentRoute mroute)
   where
-    base = stripHandlerT (fmap toTypedContent handlert) ysreGetSub ysreToParentRoute route
+    handler = fmap toTypedContent $ f SubsiteData
+      { sdToParentRoute = ysreToParentRoute
+      , sdCurrentRoute = mroute
+      , sdSubsiteData = ysreGetSub $ yreSite ysreParentEnv
+      }
diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs
index 8e447eab..7373d261 100644
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@@ -9,11 +9,12 @@
 module Yesod.Core.Class.Handler
     ( MonadHandler (..)
     , MonadWidget (..)
+    , liftHandlerT
+    , liftWidgetT
     ) where
 
 import Yesod.Core.Types
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
+import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid (Monoid)
@@ -33,25 +34,27 @@ import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
 import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
 import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 
+-- FIXME should we just use MonadReader instances instead?
 class MonadResource m => MonadHandler m where
     type HandlerSite m
-    liftHandlerT :: HandlerT (HandlerSite m) IO a -> m a
+    liftHandler :: HandlerFor (HandlerSite m) a -> m a
 
-replaceToParent :: HandlerData site route -> HandlerData site ()
-replaceToParent hd = hd { handlerToParent = const () }
+liftHandlerT :: MonadHandler m => HandlerFor (HandlerSite m) a -> m a
+liftHandlerT = liftHandler
+{-# DEPRECATED liftHandlerT "Use liftHandler instead" #-}
 
-instance MonadResourceBase m => MonadHandler (HandlerT site m) where
-    type HandlerSite (HandlerT site m) = site
-    liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent
-{-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-}
+instance MonadHandler (HandlerFor site) where
+    type HandlerSite (HandlerFor site) = site
+    liftHandler = id
+    {-# INLINE liftHandler #-}
 
-instance MonadResourceBase m => MonadHandler (WidgetT site m) where
-    type HandlerSite (WidgetT site m) = site
-    liftHandlerT (HandlerT f) = WidgetT $ \_ref env -> liftIO $ f $ replaceToParent env
-{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ const f #-}
+instance MonadHandler (WidgetFor site) where
+    type HandlerSite (WidgetFor site) = site
+    liftHandler (HandlerFor f) = WidgetFor $ f . wdHandler
+    {-# INLINE liftHandler #-}
 
-#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
-#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
+#define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
+#define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
@@ -70,12 +73,17 @@ GO(ConduitM i o)
 #undef GOX
 
 class MonadHandler m => MonadWidget m where
-    liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
-instance MonadResourceBase m => MonadWidget (WidgetT site m) where
-    liftWidgetT (WidgetT f) = WidgetT $ \ref env -> liftIO $ f ref $ replaceToParent env
+    liftWidget :: WidgetFor (HandlerSite m) a -> m a
+instance MonadWidget (WidgetFor site) where
+    liftWidget = id
+    {-# INLINE liftWidget #-}
 
-#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
-#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
+liftWidgetT :: MonadWidget m => WidgetFor (HandlerSite m) a -> m a
+liftWidgetT = liftWidget
+{-# DEPRECATED liftWidgetT "Use liftWidget instead" #-}
+
+#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidget = lift . liftWidget
+#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidget = lift . liftWidget
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs
index 5e169d7e..eafd1b34 100644
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@@ -56,7 +56,6 @@ import           Web.Cookie                         (SetCookie (..), parseCookie
 import           Yesod.Core.Types
 import           Yesod.Core.Internal.Session
 import           Yesod.Core.Widget
-import Control.Monad.Trans.Class (lift)
 import Data.CaseInsensitive (CI)
 import qualified Network.Wai.Request
 import Data.IORef
@@ -83,11 +82,11 @@ class RenderRoute site => Yesod site where
     -- | Output error response pages.
     --
     -- Default value: 'defaultErrorHandler'.
-    errorHandler :: ErrorResponse -> HandlerT site IO TypedContent
+    errorHandler :: ErrorResponse -> HandlerFor site TypedContent
     errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: WidgetT site IO () -> HandlerT site IO Html
+    defaultLayout :: WidgetFor site () -> HandlerFor site Html
     defaultLayout w = do
         p <- widgetToPageContent w
         msgs <- getMessages
@@ -139,7 +138,7 @@ class RenderRoute site => Yesod site where
     -- If authentication is required, return 'AuthenticationRequired'.
     isAuthorized :: Route site
                  -> Bool -- ^ is this a write request?
-                 -> HandlerT site IO AuthResult
+                 -> HandlerFor site AuthResult
     isAuthorized _ _ = return Authorized
 
     -- | Determines whether the current request is a write request. By default,
@@ -149,7 +148,7 @@ class RenderRoute site => Yesod site where
     --
     -- This function is used to determine if a request is authorized; see
     -- 'isAuthorized'.
-    isWriteRequest :: Route site -> HandlerT site IO Bool
+    isWriteRequest :: Route site -> HandlerFor site Bool
     isWriteRequest _ = do
         wai <- waiRequest
         return $ W.requestMethod wai `notElem`
@@ -215,7 +214,7 @@ class RenderRoute site => Yesod site where
     addStaticContent :: Text -- ^ filename extension
                      -> Text -- ^ mime-type
                      -> L.ByteString -- ^ content
-                     -> HandlerT site IO (Maybe (Either Text (Route site, [(Text, Text)])))
+                     -> HandlerFor site (Maybe (Either Text (Route site, [(Text, Text)])))
     addStaticContent _ _ _ = return Nothing
 
     -- | Maximum allowed length of the request body, in bytes.
@@ -304,7 +303,7 @@ class RenderRoute site => Yesod site where
     -- Default: the 'defaultYesodMiddleware' function.
     --
     -- Since: 1.1.6
-    yesodMiddleware :: ToTypedContent res => HandlerT site IO res -> HandlerT site IO res
+    yesodMiddleware :: ToTypedContent res => HandlerFor site res -> HandlerFor site res
     yesodMiddleware = defaultYesodMiddleware
 
     -- | How to allocate an @InternalState@ for each request.
@@ -325,7 +324,7 @@ class RenderRoute site => Yesod site where
     -- primarily for wrapping up error messages for better display.
     --
     -- @since 1.4.30
-    defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetT site IO ()
+    defaultMessageWidget :: Html -> HtmlUrl (Route site) -> WidgetFor site ()
     defaultMessageWidget title body = do
         setTitle title
         toWidget
@@ -384,7 +383,7 @@ defaultShouldLogIO a b = return $ defaultShouldLog a b
 -- \"Vary: Accept, Accept-Language\" and performs authorization checks.
 --
 -- Since 1.2.0
-defaultYesodMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultYesodMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultYesodMiddleware handler = do
     addHeader "Vary" "Accept, Accept-Language"
     authorizationCheck
@@ -444,8 +443,8 @@ sameSiteSession s = (fmap . fmap) secureSessionCookies
 --
 -- Since 1.4.7
 sslOnlyMiddleware :: Int -- ^ minutes
-                  -> HandlerT site IO res
-                  -> HandlerT site IO res
+                  -> HandlerFor site res
+                  -> HandlerFor site res
 sslOnlyMiddleware timeout handler = do
     addHeader "Strict-Transport-Security"
               $ T.pack $ concat [ "max-age="
@@ -458,7 +457,7 @@ sslOnlyMiddleware timeout handler = do
 -- 'isWriteRequest'.
 --
 -- Since 1.2.0
-authorizationCheck :: Yesod site => HandlerT site IO ()
+authorizationCheck :: Yesod site => HandlerFor site ()
 authorizationCheck = getCurrentRoute >>= maybe (return ()) checkUrl
   where
     checkUrl url = do
@@ -482,7 +481,7 @@ authorizationCheck = getCurrentRoute >>= maybe (return ()) checkUrl
 -- | Calls 'csrfCheckMiddleware' with 'isWriteRequest', 'defaultCsrfHeaderName', and 'defaultCsrfParamName' as parameters.
 --
 -- Since 1.4.14
-defaultCsrfCheckMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultCsrfCheckMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultCsrfCheckMiddleware handler =
     csrfCheckMiddleware
         handler
@@ -496,11 +495,11 @@ defaultCsrfCheckMiddleware handler =
 -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
 --
 -- Since 1.4.14
-csrfCheckMiddleware :: HandlerT site IO res
-                    -> HandlerT site IO Bool -- ^ Whether or not to perform the CSRF check.
+csrfCheckMiddleware :: HandlerFor site res
+                    -> HandlerFor site Bool -- ^ Whether or not to perform the CSRF check.
                     -> CI S8.ByteString -- ^ The header name to lookup the CSRF token from.
                     -> Text -- ^ The POST parameter name to lookup the CSRF token from.
-                    -> HandlerT site IO res
+                    -> HandlerFor site res
 csrfCheckMiddleware handler shouldCheckFn headerName paramName = do
     shouldCheck <- shouldCheckFn
     when shouldCheck (checkCsrfHeaderOrParam headerName paramName)
@@ -511,7 +510,7 @@ csrfCheckMiddleware handler shouldCheckFn headerName paramName = do
 -- The cookie's path is set to @/@, making it valid for your whole website.
 --
 -- Since 1.4.14
-defaultCsrfSetCookieMiddleware :: HandlerT site IO res -> HandlerT site IO res
+defaultCsrfSetCookieMiddleware :: HandlerFor site res -> HandlerFor site res
 defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler
 
 -- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie. See 'setCsrfCookieWithCookie'.
@@ -521,7 +520,7 @@ defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler
 -- Make sure to set the 'setCookiePath' to the root path of your application, otherwise you'll generate a new CSRF token for every path of your app. If your app is run from from e.g. www.example.com\/app1, use @app1@. The vast majority of sites will just use @/@.
 --
 -- Since 1.4.14
-csrfSetCookieMiddleware :: HandlerT site IO res -> SetCookie -> HandlerT site IO res
+csrfSetCookieMiddleware :: HandlerFor site res -> SetCookie -> HandlerFor site res
 csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handler
 
 -- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'.
@@ -541,23 +540,26 @@ csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handl
 -- @
 --
 -- Since 1.4.14
-defaultCsrfMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res
+defaultCsrfMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site res
 defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware
 
 -- | Convert a widget to a 'PageContent'.
 widgetToPageContent :: Yesod site
-                    => WidgetT site IO ()
-                    -> HandlerT site IO (PageContent (Route site))
-widgetToPageContent w = do
-    master <- getYesod
-    hd <- HandlerT return
-    ref <- lift $ newIORef mempty
-    lift $ unWidgetT w ref hd
-    GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- lift $ readIORef ref
-    let title = maybe mempty unTitle mTitle
-        scripts = runUniqueList scripts'
-        stylesheets = runUniqueList stylesheets'
+                    => WidgetFor site ()
+                    -> HandlerFor site (PageContent (Route site))
+widgetToPageContent w = HandlerFor $ \hd -> do
+  master <- unHandlerFor getYesod hd
+  ref <- newIORef mempty
+  unWidgetFor w WidgetData
+    { wdRef = ref
+    , wdHandler = hd
+    }
+  GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- readIORef ref
+  let title = maybe mempty unTitle mTitle
+      scripts = runUniqueList scripts'
+      stylesheets = runUniqueList stylesheets'
 
+  flip unHandlerFor hd $ do
     render <- getUrlRenderParams
     let renderLoc x =
             case x of
@@ -645,7 +647,7 @@ widgetToPageContent w = do
     runUniqueList (UniqueList x) = nub $ x []
 
 -- | The default error handler for 'errorHandler'.
-defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerT site IO TypedContent
+defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerFor site TypedContent
 defaultErrorHandler NotFound = selectRep $ do
     provideRep $ defaultLayout $ do
         r <- waiRequest
diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs
index d13a154d..bd3c41c6 100644
--- a/yesod-core/Yesod/Core/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Dispatch.hs
@@ -35,7 +35,6 @@ module Yesod.Core.Dispatch
       -- * WAI subsites
     , WaiSubsite (..)
     , WaiSubsiteWithAuth (..)
-    , subHelper
     ) where
 
 import Prelude hiding (exp)
diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs
index bfd254d0..f8cd1666 100644
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@@ -27,6 +27,7 @@
 module Yesod.Core.Handler
     ( -- * Handler monad
       HandlerT
+    , HandlerFor
       -- ** Read information from handler
     , getYesod
     , getsYesod
@@ -161,7 +162,6 @@ module Yesod.Core.Handler
       -- * Per-request caching
     , cached
     , cachedBy
-    , stripHandlerT
       -- * AJAX CSRF protection
 
       -- $ajaxCSRFOverview
@@ -254,14 +254,17 @@ import qualified Data.Foldable as Fold
 import           Data.Default
 import           Control.Monad.Logger (MonadLogger, logWarnS)
 
+type HandlerT site (m :: * -> *) = HandlerFor site
+{-# DEPRECATED HandlerT "Use HandlerFor directly" #-}
+
 get :: MonadHandler m => m GHState
-get = liftHandlerT $ HandlerT $ I.readIORef . handlerState
+get = liftHandler $ HandlerFor $ I.readIORef . handlerState
 
 put :: MonadHandler m => GHState -> m ()
-put x = liftHandlerT $ HandlerT $ flip I.writeIORef x . handlerState
+put x = liftHandler $ HandlerFor $ flip I.writeIORef x . handlerState
 
 modify :: MonadHandler m => (GHState -> GHState) -> m ()
-modify f = liftHandlerT $ HandlerT $ flip I.modifyIORef f . handlerState
+modify f = liftHandler $ HandlerFor $ flip I.modifyIORef f . handlerState
 
 tell :: MonadHandler m => Endo [Header] -> m ()
 tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs }
@@ -273,14 +276,14 @@ hcError :: MonadHandler m => ErrorResponse -> m a
 hcError = handlerError . HCError
 
 getRequest :: MonadHandler m => m YesodRequest
-getRequest = liftHandlerT $ HandlerT $ return . handlerRequest
+getRequest = liftHandler $ HandlerFor $ return . handlerRequest
 
 runRequestBody :: MonadHandler m => m RequestBodyContents
 runRequestBody = do
     HandlerData
         { handlerEnv = RunHandlerEnv {..}
         , handlerRequest = req
-        } <- liftHandlerT $ HandlerT return
+        } <- liftHandler $ HandlerFor return
     let len = W.requestBodyLength $ reqWaiRequest req
         upload = rheUpload len
     x <- get
@@ -320,7 +323,7 @@ rbHelper' backend mkFI req =
     go = decodeUtf8With lenientDecode
 
 askHandlerEnv :: MonadHandler m => m (RunHandlerEnv (HandlerSite m))
-askHandlerEnv = liftHandlerT $ HandlerT $ return . handlerEnv
+askHandlerEnv = liftHandler $ HandlerFor $ return . handlerEnv
 
 -- | Get the master site application argument.
 getYesod :: MonadHandler m => m (HandlerSite m)
@@ -396,9 +399,9 @@ getCurrentRoute = rheRoute <$> askHandlerEnv
 -- This allows the inner 'GHandler' to outlive the outer
 -- 'GHandler' (e.g., on the @forkIO@ example above, a response
 -- may be sent to the client without killing the new thread).
-handlerToIO :: (MonadIO m1, MonadIO m2) => HandlerT site m1 (HandlerT site IO a -> m2 a)
+handlerToIO :: MonadIO m => HandlerFor site (HandlerFor site a -> m a)
 handlerToIO =
-  HandlerT $ \oldHandlerData -> do
+  HandlerFor $ \oldHandlerData -> do
     -- Take just the bits we need from oldHandlerData.
     let newReq = oldReq { reqWaiRequest = newWaiReq }
           where
@@ -420,7 +423,7 @@ handlerToIO =
     liftIO $ evaluate (newReq `seq` oldEnv `seq` newState `seq` ())
 
     -- Return GHandler running function.
-    return $ \(HandlerT f) ->
+    return $ \(HandlerFor f) ->
       liftIO $
       runResourceT $ withInternalState $ \resState -> do
         -- The state IORef needs to be created here, otherwise it
@@ -431,7 +434,6 @@ handlerToIO =
                 { handlerRequest  = newReq
                 , handlerEnv      = oldEnv
                 , handlerState    = newStateIORef
-                , handlerToParent = const ()
                 , handlerResource = resState
                 }
         liftIO (f newHandlerData)
@@ -442,9 +444,9 @@ handlerToIO =
 -- for correctness and efficiency
 --
 -- @since 1.2.8
-forkHandler :: (SomeException -> HandlerT site IO ()) -- ^ error handler
-              -> HandlerT site IO ()
-              -> HandlerT site IO ()
+forkHandler :: (SomeException -> HandlerFor site ()) -- ^ error handler
+              -> HandlerFor site ()
+              -> HandlerFor site ()
 forkHandler onErr handler = do
     yesRunner <- handlerToIO
     void $ liftResourceT $ resourceForkIO $ yesRunner $ handle onErr handler
@@ -1370,14 +1372,14 @@ respond ct = return . TypedContent ct . toContent
 --
 -- @since 1.2.0
 respondSource :: ContentType
-              -> Source (HandlerT site IO) (Flush Builder)
-              -> HandlerT site IO TypedContent
-respondSource ctype src = HandlerT $ \hd ->
+              -> Source (HandlerFor site) (Flush Builder)
+              -> HandlerFor site TypedContent
+respondSource ctype src = HandlerFor $ \hd ->
     -- Note that this implementation relies on the fact that the ResourceT
     -- environment provided by the server is the same one used in HandlerT.
     -- This is a safe assumption assuming the HandlerT is run correctly.
     return $ TypedContent ctype $ ContentSource
-           $ transPipe (lift . flip unHandlerT hd) src
+           $ transPipe (lift . flip unHandlerFor hd) src
 
 -- | In a streaming response, send a single chunk of data. This function works
 -- on most datatypes, such as @ByteString@ and @Html@.
@@ -1423,25 +1425,6 @@ sendChunkLazyText = sendChunk
 sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
 sendChunkHtml = sendChunk
 
--- | Converts a child handler to a parent handler
---
--- Exported since 1.4.11
-stripHandlerT :: HandlerT child (HandlerT parent m) a
-              -> (parent -> child)
-              -> (Route child -> Route parent)
-              -> Maybe (Route child)
-              -> HandlerT parent m a
-stripHandlerT (HandlerT f) getSub toMaster newRoute = HandlerT $ \hd -> do
-    let env = handlerEnv hd
-    ($ hd) $ unHandlerT $ f hd
-        { handlerEnv = env
-            { rheSite = getSub $ rheSite env
-            , rheRoute = newRoute
-            , rheRender = \url params -> rheRender env (toMaster url) params
-            }
-        , handlerToParent = toMaster
-        }
-
 -- $ajaxCSRFOverview
 -- When a user has authenticated with your site, all requests made from the browser to your server will include the session information that you use to verify that the user is logged in.
 -- Unfortunately, this allows attackers to make unwanted requests on behalf of the user by e.g. submitting an HTTP request to your site when the user visits theirs.
diff --git a/yesod-core/Yesod/Core/Internal/LiteApp.hs b/yesod-core/Yesod/Core/Internal/LiteApp.hs
index b09217c6..c9a6f51d 100644
--- a/yesod-core/Yesod/Core/Internal/LiteApp.hs
+++ b/yesod-core/Yesod/Core/Internal/LiteApp.hs
@@ -46,8 +46,8 @@ instance Monoid LiteApp where
     mempty = LiteApp $ \_ _ -> Nothing
     mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps
 
-type LiteHandler = HandlerT LiteApp IO
-type LiteWidget = WidgetT LiteApp IO
+type LiteHandler = HandlerFor LiteApp
+type LiteWidget = WidgetFor LiteApp
 
 liteApp :: Writer LiteApp () -> LiteApp
 liteApp = execWriter
diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs
index 668e8604..4f8e69a1 100644
--- a/yesod-core/Yesod/Core/Internal/Run.hs
+++ b/yesod-core/Yesod/Core/Internal/Run.hs
@@ -83,7 +83,7 @@ errFromShow x = evaluate $!! InternalError $! T.pack $! show x
 -- represented by the @HandlerContents@.
 basicRunHandler :: ToTypedContent c
                 => RunHandlerEnv site
-                -> HandlerT site IO c
+                -> HandlerFor site c
                 -> YesodRequest
                 -> InternalState
                 -> IO (GHState, HandlerContents)
@@ -96,7 +96,7 @@ basicRunHandler rhe handler yreq resState = do
     -- converting them into a @HandlerContents@
     contents' <- catchSync
         (do
-            res <- unHandlerT handler (hd istate)
+            res <- unHandlerFor handler (hd istate)
             tc <- evaluate (toTypedContent res)
             -- Success! Wrap it up in an @HCContent@
             return (HCContent defaultStatus tc))
@@ -121,7 +121,6 @@ basicRunHandler rhe handler yreq resState = do
         { handlerRequest = yreq
         , handlerEnv     = rhe
         , handlerState   = istate
-        , handlerToParent = const ()
         , handlerResource = resState
         }
 
@@ -208,7 +207,7 @@ evalFallback contents val = catchSync
 -- 'HandlerT' into an 'Application'. Should not be needed by users.
 runHandler :: ToTypedContent c
            => RunHandlerEnv site
-           -> HandlerT site IO c
+           -> HandlerFor site c
            -> YesodApp
 runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> do
     -- Get the raw state and original contents
@@ -263,7 +262,7 @@ runFakeHandler :: (Yesod site, MonadIO m) =>
                   SessionMap
                -> (site -> Logger)
                -> site
-               -> HandlerT site IO a
+               -> HandlerFor site a
                -> m (Either ErrorResponse a)
 runFakeHandler fakeSessionMap logger site handler = liftIO $ do
   ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")
@@ -322,7 +321,7 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do
   I.readIORef ret
 
 yesodRunner :: (ToTypedContent res, Yesod site)
-            => HandlerT site IO res
+            => HandlerFor site res
             -> YesodRunnerEnv site
             -> Maybe (Route site)
             -> Application
diff --git a/yesod-core/Yesod/Core/Internal/TH.hs b/yesod-core/Yesod/Core/Internal/TH.hs
index 8ee5b4e0..fbfee2ed 100644
--- a/yesod-core/Yesod/Core/Internal/TH.hs
+++ b/yesod-core/Yesod/Core/Internal/TH.hs
@@ -32,7 +32,6 @@ import Text.ParserCombinators.Parsec.Char (alphaNum, spaces, string, char)
 import Yesod.Routes.TH
 import Yesod.Routes.Parse
 import Yesod.Core.Types
-import Yesod.Core.Content
 import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
 
@@ -102,12 +101,12 @@ mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
 mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False return
 
 -- | Get the Handler and Widget type synonyms for the given site.
-masterTypeSyns :: [Name] -> Type -> [Dec]
+masterTypeSyns :: [Name] -> Type -> [Dec] -- FIXME remove from here, put into the scaffolding itself?
 masterTypeSyns vs site =
     [ TySynD (mkName "Handler") (fmap PlainTV vs)
-      $ ConT ''HandlerT `AppT` site `AppT` ConT ''IO
+      $ ConT ''HandlerFor `AppT` site
     , TySynD (mkName "Widget")  (fmap PlainTV vs)
-      $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
+      $ ConT ''WidgetFor `AppT` site `AppT` ConT ''()
     ]
 
 -- | 'Left' arguments indicate a monomorphic type, a 'Right' argument
@@ -242,7 +241,7 @@ mkDispatchInstance master cxt f res = do
 
 mkYesodSubDispatch :: [ResourceTree a] -> Q Exp
 mkYesodSubDispatch res = do
-    clause' <- mkDispatchClause (mkMDS return [|subHelper . fmap toTypedContent|]) res
+    clause' <- mkDispatchClause (mkMDS return [|subHelper|]) res
     inner <- newName "inner"
     let innerFun = FunD inner [clause']
     helper <- newName "helper"
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 245aad90..441b3e92 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@@ -31,14 +31,14 @@ module Yesod.Core.Json
     , acceptsJson
     ) where
 
-import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader)
+import Yesod.Core.Handler (HandlerFor, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep, lookupHeader)
 import Control.Monad.Trans.Writer (Writer)
 import Data.Monoid (Endo)
 import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Types (reqAccept)
 import Yesod.Core.Class.Yesod (defaultLayout, Yesod)
 import Yesod.Core.Class.Handler
-import Yesod.Core.Widget (WidgetT)
+import Yesod.Core.Widget (WidgetFor)
 import Yesod.Routes.Class
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Parser as JP
@@ -58,9 +58,9 @@ import Control.Monad (liftM)
 --
 -- @since 0.3.0
 defaultLayoutJson :: (Yesod site, J.ToJSON a)
-                  => WidgetT site IO ()  -- ^ HTML
-                  -> HandlerT site IO a  -- ^ JSON
-                  -> HandlerT site IO TypedContent
+                  => WidgetFor site ()  -- ^ HTML
+                  -> HandlerFor site a  -- ^ JSON
+                  -> HandlerFor site TypedContent
 defaultLayoutJson w json = selectRep $ do
     provideRep $ defaultLayout w
     provideRep $ fmap J.toEncoding json
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index fd4572de..4211ba43 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TupleSections #-}
@@ -18,14 +19,14 @@ import           Data.Monoid                        (Monoid (..))
 #endif
 import           Control.Arrow                      (first)
 import           Control.Exception                  (Exception)
-import           Control.Monad                      (liftM, ap)
+import           Control.Monad                      (ap)
 import           Control.Monad.Base                 (MonadBase (liftBase))
 import           Control.Monad.Catch                (MonadMask (..), MonadCatch (..))
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel, LogSource,
                                                      MonadLogger (..))
 import           Control.Monad.Trans.Control        (MonadBaseControl (..))
-import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), monadThrow, ResourceT)
+import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), ResourceT)
 import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
 import           Data.Conduit                       (Flush, Source)
@@ -56,7 +57,6 @@ import           Text.Hamlet                        (HtmlUrl)
 import           Text.Julius                        (JavascriptUrl)
 import           Web.Cookie                         (SetCookie)
 import           Yesod.Core.Internal.Util           (getTime, putTime)
-import           Control.Monad.Trans.Class          (MonadTrans (..))
 import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
 import           Control.Monad.Reader               (MonadReader (..))
 import           Data.Monoid                        ((<>))
@@ -66,7 +66,7 @@ import Data.Conduit.Lazy (MonadActive, monadActive)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
 import Control.Monad.Logger (MonadLoggerIO (..))
 import Data.Semigroup (Semigroup)
-import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..), withUnliftIO)
+import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..))
 
 -- Sessions
 type SessionMap = Map Text ByteString
@@ -193,11 +193,10 @@ data RunHandlerEnv site = RunHandlerEnv
     , rheMaxExpires :: !Text
     }
 
-data HandlerData site parentRoute = HandlerData
+data HandlerData site = HandlerData
     { handlerRequest  :: !YesodRequest
     , handlerEnv      :: !(RunHandlerEnv site)
     , handlerState    :: !(IORef GHState)
-    , handlerToParent :: !(Route site -> parentRoute)
     , handlerResource :: !InternalState
     }
 
@@ -224,16 +223,13 @@ type ParentRunner parent m
 
 -- | A generic handler monad, which can have a different subsite and master
 -- site. We define a newtype for better error message.
-newtype HandlerT site m a = HandlerT
-    { unHandlerT :: HandlerData site (MonadRoute m) -> m a
+newtype HandlerFor site a = HandlerFor
+    { unHandlerFor :: HandlerData site -> IO a
     }
-
-type family MonadRoute (m :: * -> *)
-type instance MonadRoute IO = ()
-type instance MonadRoute (HandlerT site m) = (Route site)
+    deriving Functor
 
 data GHState = GHState
-    { ghsSession :: SessionMap
+    { ghsSession :: !SessionMap
     , ghsRBC     :: Maybe RequestBodyContents
     , ghsIdent   :: Int
     , ghsCache   :: TypeMap
@@ -249,26 +245,32 @@ type YesodApp = YesodRequest -> ResourceT IO YesodResponse
 -- | A generic widget, allowing specification of both the subsite and master
 -- site datatypes. While this is simply a @WriterT@, we define a newtype for
 -- better error messages.
-newtype WidgetT site m a = WidgetT
-    { unWidgetT :: IORef (GWData (Route site)) -> HandlerData site (MonadRoute m) -> m a
+newtype WidgetFor site a = WidgetFor
+    { unWidgetFor :: WidgetData site -> IO a
     }
+    deriving Functor
 
-instance (a ~ (), Monad m) => Monoid (WidgetT site m a) where
+data WidgetData site = WidgetData
+  { wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
+  , wdHandler :: {-# UNPACK #-} !(HandlerData site)
+  }
+
+instance a ~ () => Monoid (WidgetFor site a) where
     mempty = return ()
     mappend x y = x >> y
-instance (a ~ (), Monad m) => Semigroup (WidgetT site m a)
+instance a ~ () => Semigroup (WidgetFor site a)
 
 -- | A 'String' can be trivially promoted to a widget.
 --
 -- For example, in a yesod-scaffold site you could use:
 --
 -- @getHomeR = do defaultLayout "Widget text"@
-instance (MonadIO m, a ~ ()) => IsString (WidgetT site m a) where -- FIXME turn it into WidgetFor?
+instance a ~ () => IsString (WidgetFor site a) where
     fromString = toWidget . toHtml . T.pack
       where toWidget x = tellWidget mempty { gwdBody = Body (const x) }
 
-tellWidget :: MonadIO m => GWData (Route site) -> WidgetT site m ()
-tellWidget d = WidgetT $ \ref _ -> liftIO $ modifyIORef' ref (<> d)
+tellWidget :: GWData (Route site) -> WidgetFor site ()
+tellWidget d = WidgetFor $ \wd -> modifyIORef' (wdRef wd) (<> d)
 
 type RY master = Route master -> [(Text, Text)] -> Text
 
@@ -404,106 +406,85 @@ instance Show HandlerContents where
     show (HCWaiApp _) = "HCWaiApp"
 instance Exception HandlerContents
 
--- Instances for WidgetT
-instance Monad m => Functor (WidgetT site m) where
-    fmap = liftM
-instance Monad m => Applicative (WidgetT site m) where
-    pure = return
+-- Instances for WidgetFor
+instance Applicative (WidgetFor site) where
+    pure = WidgetFor . const . pure
     (<*>) = ap
-instance Monad m => Monad (WidgetT site m) where
-    return a = WidgetT $ \_ _ -> return a
-    WidgetT x >>= f = WidgetT $ \ref r -> do
-        a <- x ref r
-        unWidgetT (f a) ref r
-instance MonadIO m => MonadIO (WidgetT site m) where
-    liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (WidgetT site m) where
-    liftBase = WidgetT . const . const . liftBase
-instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-    type StM (WidgetT site m) a = StM m a
-    liftBaseWith f = WidgetT $ \ref reader' ->
+instance Monad (WidgetFor site) where
+    return = pure
+    WidgetFor x >>= f = WidgetFor $ \wd -> do
+        a <- x wd
+        unWidgetFor (f a) wd
+instance MonadIO (WidgetFor site) where
+    liftIO = WidgetFor . const
+instance b ~ IO => MonadBase b (WidgetFor site) where
+    liftBase = WidgetFor . const
+instance b ~ IO => MonadBaseControl b (WidgetFor site) where
+    type StM (WidgetFor site) a = a
+    liftBaseWith f = WidgetFor $ \wd ->
         liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(WidgetT w) -> w ref reader')
-    restoreM = WidgetT . const . const . restoreM
+            f $ runInBase . (flip unWidgetFor wd)
+    restoreM = WidgetFor . const . return
 -- | @since 1.4.38
-instance MonadUnliftIO m => MonadUnliftIO (WidgetT site m) where
+instance MonadUnliftIO (WidgetFor site) where
   {-# INLINE askUnliftIO #-}
-  askUnliftIO = WidgetT $ \ref r ->
-                withUnliftIO $ \u ->
-                return (UnliftIO (\(WidgetT w) -> unliftIO u $ w ref r))
-instance Monad m => MonadReader site (WidgetT site m) where
-    ask = WidgetT $ \_ hd -> return (rheSite $ handlerEnv hd)
-    local f (WidgetT g) = WidgetT $ \ref hd -> g ref hd
-        { handlerEnv = (handlerEnv hd)
-            { rheSite = f $ rheSite $ handlerEnv hd
-            }
-        }
+  askUnliftIO = WidgetFor $ \wd ->
+                return (UnliftIO (flip unWidgetFor wd))
+instance MonadReader (WidgetData site) (WidgetFor site) where
+    ask = WidgetFor return
+    local f (WidgetFor g) = WidgetFor $ g . f
 
-instance MonadTrans (WidgetT site) where
-    lift = WidgetT . const . const
-instance MonadThrow m => MonadThrow (WidgetT site m) where
-    throwM = lift . throwM
+instance MonadThrow (WidgetFor site) where
+    throwM = liftIO . throwM
 
-instance MonadCatch m => MonadCatch (HandlerT site m) where
-  catch (HandlerT m) c = HandlerT $ \r -> m r `catch` \e -> unHandlerT (c e) r
-instance MonadMask m => MonadMask (HandlerT site m) where
-  mask a = HandlerT $ \e -> mask $ \u -> unHandlerT (a $ q u) e
-    where q u (HandlerT b) = HandlerT (u . b)
+instance MonadCatch (HandlerFor site) where
+  catch (HandlerFor m) c = HandlerFor $ \r -> m r `catch` \e -> unHandlerFor (c e) r
+instance MonadMask (HandlerFor site) where
+  mask a = HandlerFor $ \e -> mask $ \u -> unHandlerFor (a $ q u) e
+    where q u (HandlerFor b) = HandlerFor (u . b)
   uninterruptibleMask a =
-    HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
-      where q u (HandlerT b) = HandlerT (u . b)
-instance MonadCatch m => MonadCatch (WidgetT site m) where
-  catch (WidgetT m) c = WidgetT $ \ref r -> m ref r `catch` \e -> unWidgetT (c e) ref r
-instance MonadMask m => MonadMask (WidgetT site m) where
-  mask a = WidgetT $ \ref e -> mask $ \u -> unWidgetT (a $ q u) ref e
-    where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
+    HandlerFor $ \e -> uninterruptibleMask $ \u -> unHandlerFor (a $ q u) e
+      where q u (HandlerFor b) = HandlerFor (u . b)
+instance MonadCatch (WidgetFor site) where
+  catch (WidgetFor m) c = WidgetFor $ \r -> m r `catch` \e -> unWidgetFor (c e) r
+instance MonadMask (WidgetFor site) where
+  mask a = WidgetFor $ \e -> mask $ \u -> unWidgetFor (a $ q u) e
+    where q u (WidgetFor b) = WidgetFor (u . b)
   uninterruptibleMask a =
-    WidgetT $ \ref e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) ref e
-      where q u (WidgetT b) = WidgetT (\ref e -> u $ b ref e)
+    WidgetFor $ \e -> uninterruptibleMask $ \u -> unWidgetFor (a $ q u) e
+      where q u (WidgetFor b) = WidgetFor (u . b)
 
--- CPP to avoid a redundant constraints warning
-#if MIN_VERSION_base(4,9,0)
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#else
-instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-#endif
-    liftResourceT f = WidgetT $ \_ hd -> liftIO $ runInternalState f (handlerResource hd)
+instance MonadResource (WidgetFor site) where
+    liftResourceT f = WidgetFor $ runInternalState f . handlerResource . wdHandler
 
-instance MonadIO m => MonadLogger (WidgetT site m) where
-    monadLoggerLog a b c d = WidgetT $ \_ hd ->
-        liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
+instance MonadLogger (WidgetFor site) where
+    monadLoggerLog a b c d = WidgetFor $ \wd ->
+        rheLog (handlerEnv $ wdHandler wd) a b c (toLogStr d)
 
-instance MonadIO m => MonadLoggerIO (WidgetT site m) where
-    askLoggerIO = WidgetT $ \_ hd -> return $ rheLog $ handlerEnv hd
+instance MonadLoggerIO (WidgetFor site) where
+    askLoggerIO = WidgetFor $ return . rheLog . handlerEnv . wdHandler
 
-instance MonadActive m => MonadActive (WidgetT site m) where
-    monadActive = lift monadActive
-instance MonadActive m => MonadActive (HandlerT site m) where
-    monadActive = lift monadActive
-
-instance MonadTrans (HandlerT site) where
-    lift = HandlerT . const
+-- FIXME look at implementation of ResourceT
+instance MonadActive (WidgetFor site) where
+    monadActive = liftIO monadActive
+instance MonadActive (HandlerFor site) where
+    monadActive = liftIO monadActive
 
 -- Instances for HandlerT
-instance Monad m => Functor (HandlerT site m) where
-    fmap = liftM
-instance Monad m => Applicative (HandlerT site m) where
-    pure = return
+instance Applicative (HandlerFor site) where
+    pure = HandlerFor . const . return
     (<*>) = ap
-instance Monad m => Monad (HandlerT site m) where
-    return = HandlerT . const . return
-    HandlerT x >>= f = HandlerT $ \r -> x r >>= \x' -> unHandlerT (f x') r
-instance MonadIO m => MonadIO (HandlerT site m) where
-    liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (HandlerT site m) where
-    liftBase = lift . liftBase
-instance Monad m => MonadReader site (HandlerT site m) where
-    ask = HandlerT $ return . rheSite . handlerEnv
-    local f (HandlerT g) = HandlerT $ \hd -> g hd
-        { handlerEnv = (handlerEnv hd)
-            { rheSite = f $ rheSite $ handlerEnv hd
-            }
-        }
+instance Monad (HandlerFor site) where
+    return = pure
+    HandlerFor x >>= f = HandlerFor $ \r -> x r >>= \x' -> unHandlerFor (f x') r
+instance MonadIO (HandlerFor site) where
+    liftIO = HandlerFor . const
+instance b ~ IO => MonadBase b (HandlerFor site) where
+    liftBase = liftIO
+instance MonadReader (HandlerData site) (HandlerFor site) where
+    ask = HandlerFor return
+    local f (HandlerFor g) = HandlerFor $ g . f
+
 -- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
 -- @fork@ function is incompatible with the underlying @ResourceT@ system.
 -- Instead, if you must fork a separate thread, you should use
@@ -512,31 +493,30 @@ instance Monad m => MonadReader site (HandlerT site m) where
 -- Using fork usually leads to an exception that says
 -- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed
 -- after cleanup. Please contact the maintainers.\"
-instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where
-    type StM (HandlerT site m) a = StM m a
-    liftBaseWith f = HandlerT $ \reader' ->
+instance b ~ IO => MonadBaseControl b (HandlerFor site) where
+    type StM (HandlerFor site) a = a
+    liftBaseWith f = HandlerFor $ \reader' ->
         liftBaseWith $ \runInBase ->
-            f $ runInBase . (\(HandlerT r) -> r reader')
-    restoreM = HandlerT . const . restoreM
+            f $ runInBase . (flip unHandlerFor reader')
+    restoreM = HandlerFor . const . return
 -- | @since 1.4.38
-instance MonadUnliftIO m => MonadUnliftIO (HandlerT site m) where
+instance MonadUnliftIO (HandlerFor site) where
   {-# INLINE askUnliftIO #-}
-  askUnliftIO = HandlerT $ \r ->
-                withUnliftIO $ \u ->
-                return (UnliftIO (unliftIO u . flip unHandlerT r))
+  askUnliftIO = HandlerFor $ \r ->
+                return (UnliftIO (flip unHandlerFor r))
 
-instance MonadThrow m => MonadThrow (HandlerT site m) where
-    throwM = lift . monadThrow
+instance MonadThrow (HandlerFor site) where
+    throwM = liftIO . throwM
 
-instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (HandlerT site m) where
-    liftResourceT f = HandlerT $ \hd -> liftIO $ runInternalState f (handlerResource hd)
+instance MonadResource (HandlerFor site) where
+    liftResourceT f = HandlerFor $ runInternalState f . handlerResource
 
-instance MonadIO m => MonadLogger (HandlerT site m) where
-    monadLoggerLog a b c d = HandlerT $ \hd ->
-        liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
+instance MonadLogger (HandlerFor site) where
+    monadLoggerLog a b c d = HandlerFor $ \hd ->
+        rheLog (handlerEnv hd) a b c (toLogStr d)
 
-instance MonadIO m => MonadLoggerIO (HandlerT site m) where
-    askLoggerIO = HandlerT $ \hd -> return (rheLog (handlerEnv hd))
+instance MonadLoggerIO (HandlerFor site) where
+    askLoggerIO = HandlerFor $ \hd -> return (rheLog (handlerEnv hd))
 
 instance Monoid (UniqueList x) where
     mempty = UniqueList id
diff --git a/yesod-core/Yesod/Core/Unsafe.hs b/yesod-core/Yesod/Core/Unsafe.hs
index ea15e7b3..c4d75b1e 100644
--- a/yesod-core/Yesod/Core/Unsafe.hs
+++ b/yesod-core/Yesod/Core/Unsafe.hs
@@ -19,7 +19,10 @@ import Control.Monad.IO.Class (MonadIO)
 --
 -- > unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 fakeHandlerGetLogger :: (Yesod site, MonadIO m)
-                     => (site -> Logger) -> site -> HandlerT site IO a -> m a
+                     => (site -> Logger)
+                     -> site
+                     -> HandlerFor site a
+                     -> m a
 fakeHandlerGetLogger getLogger app f =
      runFakeHandler mempty getLogger app f
  >>= either (error . ("runFakeHandler issue: " `mappend`) . show)
diff --git a/yesod-core/Yesod/Core/Widget.hs b/yesod-core/Yesod/Core/Widget.hs
index f9e1eeb3..67ac6380 100644
--- a/yesod-core/Yesod/Core/Widget.hs
+++ b/yesod-core/Yesod/Core/Widget.hs
@@ -14,6 +14,7 @@
 module Yesod.Core.Widget
     ( -- * Datatype
       WidgetT
+    , WidgetFor
     , PageContent (..)
       -- * Special Hamlet quasiquoter/TH for Widgets
     , whamlet
@@ -43,7 +44,6 @@ module Yesod.Core.Widget
     , addScriptRemoteAttrs
     , addScriptEither
       -- * Subsites
-    , widgetToParentWidget
     , handlerToWidget
       -- * Internal
     , whamletFileWithSettings
@@ -60,7 +60,6 @@ import Yesod.Core.Handler (getMessageRender, getUrlRenderParams)
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
-import Control.Monad.IO.Class (MonadIO, liftIO)
 import Text.Shakespeare.I18N (RenderMessage)
 import Data.Text (Text)
 import qualified Data.Map as Map
@@ -72,11 +71,13 @@ import Data.Text.Lazy.Builder (fromLazyText)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
-import Data.IORef
 
 import Yesod.Core.Types
 import Yesod.Core.Class.Handler
 
+type WidgetT site (m :: * -> *) = WidgetFor site
+{-# DEPRECATED WidgetT "Use WidgetFor directly" #-}
+
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
@@ -97,8 +98,8 @@ instance render ~ RY site => ToWidget site (render -> Javascript) where
     toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
 instance ToWidget site Javascript where
     toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
-instance (site' ~ site, IO ~ m, a ~ ()) => ToWidget site' (WidgetT site m a) where
-    toWidget = liftWidgetT
+instance (site' ~ site, a ~ ()) => ToWidget site' (WidgetFor site a) where
+    toWidget = liftWidget
 instance ToWidget site Html where
     toWidget = toWidget . const
 -- | @since 1.4.28
@@ -268,49 +269,10 @@ ihamletToHtml ih = do
     return $ ih (toHtml . mrender) urender
 
 tell :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
-tell = liftWidgetT . tellWidget
+tell = liftWidget . tellWidget
 
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
 
-handlerToWidget :: Monad m => HandlerT site m a -> WidgetT site m a
-handlerToWidget (HandlerT f) = WidgetT $ const f
-
-widgetToParentWidget :: MonadIO m
-                     => WidgetT child IO a
-                     -> HandlerT child (HandlerT parent m) (WidgetT parent m a)
-widgetToParentWidget (WidgetT f) = HandlerT $ \hdChild -> do
-    return $ WidgetT $ \ref _hdParent -> liftIO $ do
-      tmp <- newIORef mempty
-      a <- f tmp hdChild { handlerToParent = const () }
-      gwd <- readIORef tmp
-      modifyIORef' ref (<> liftGWD (handlerToParent hdChild) gwd)
-      return a
-
-liftGWD :: (child -> parent) -> GWData child -> GWData parent
-liftGWD tp gwd = GWData
-    { gwdBody        = fixBody $ gwdBody gwd
-    , gwdTitle       = gwdTitle gwd
-    , gwdScripts     = fixUnique fixScript $ gwdScripts gwd
-    , gwdStylesheets = fixUnique fixStyle $ gwdStylesheets gwd
-    , gwdCss         = fixCss <$> gwdCss gwd
-    , gwdJavascript  = fixJS <$> gwdJavascript gwd
-    , gwdHead        = fixHead $ gwdHead gwd
-    }
-  where
-    fixRender f route = f (tp route)
-
-    fixBody (Body h) = Body $ h . fixRender
-    fixHead (Head h) = Head $ h . fixRender
-
-    fixUnique go (UniqueList f) = UniqueList (map go (f []) ++)
-
-    fixScript (Script loc attrs) = Script (fixLoc loc) attrs
-    fixStyle (Stylesheet loc attrs) = Stylesheet (fixLoc loc) attrs
-
-    fixLoc (Local url) = Local $ tp url
-    fixLoc (Remote t) = Remote t
-
-    fixCss f = f . fixRender
-
-    fixJS f = f . fixRender
+handlerToWidget :: HandlerFor site a -> WidgetFor site a
+handlerToWidget (HandlerFor f) = WidgetFor $ f . wdHandler
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
index 0785df0b..c01af705 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
+++ b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-} -- the module name is a lie!!!
 module YesodCoreTest.NoOverloadedStrings
     ( noOverloadedTest
@@ -20,19 +21,19 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 getSubsite :: a -> Subsite
 getSubsite _ = Subsite $(mkYesodSubDispatch resourcesSubsite)
 
-getBarR :: Monad m => m T.Text
+getBarR :: MonadSubHandler m => m T.Text
 getBarR = return $ T.pack "BarR"
 
-getBazR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
-getBazR = lift $ defaultLayout [whamlet|Used Default Layout|]
+getBazR :: (MonadSubHandler m, Yesod (HandlerSite m)) => m Html
+getBazR = liftHandler $ defaultLayout [whamlet|Used Default Layout|]
 
-getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
+getBinR :: (MonadSubHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
 getBinR = do
-    widget <- widgetToParentWidget [whamlet|
+    toParentRoute <- getToParentRoute
+    liftHandler $ defaultLayout [whamlet|
         <p>Used defaultLayoutT
-        <a href=@{BazR}>Baz
+        <a href=@{toParentRoute BazR}>Baz
     |]
-    lift $ defaultLayout widget
 
 getOnePiecesR :: Monad m => Int -> m ()
 getOnePiecesR _ = return ()
diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
index e8be9c14..170fd711 100644
--- a/yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs
+++ b/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 (HandlerT master IO) -> Application)
+data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerFor 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 (HandlerT master IO) where
+instance Yesod master => YesodSubDispatch Subsite (HandlerFor master) where
     yesodSubDispatch ysre =
         f ysre
       where