Simplified GHandler/GWidget

yesod-core/Yesod/Core.hs

@@ -49,7 +49,7 @@ module Yesod.Core
     , BottomOfHeadAsync
       -- * Subsites
     , defaultLayoutT
-    , MonadHandlerBase (..)
+    , MonadHandler (..)
       -- * Misc
     , yesodVersion
     , yesodRender
@@ -92,8 +92,8 @@ import Data.Version (showVersion)
 import Yesod.Routes.Class (RenderRoute (..))
 
 -- | Return an 'Unauthorized' value, with the given i18n message.
-unauthorizedI :: RenderMessage master msg => msg -> GHandler sub master AuthResult
+unauthorizedI :: RenderMessage site msg => msg -> GHandler site AuthResult
-unauthorizedI msg =do
+unauthorizedI msg = do
     mr <- getMessageRender
     return $ Unauthorized $ mr msg
 
@@ -104,37 +104,19 @@ yesodVersion = showVersion Paths_yesod_core.version
 --
 -- Built on top of 'isAuthorized'. This is useful for building page that only
 -- contain links to pages the user is allowed to see.
-maybeAuthorized :: Yesod a
+maybeAuthorized :: Yesod site
-                => Route a
+                => Route site
                 -> Bool -- ^ is this a write request?
-                -> GHandler s a (Maybe (Route a))
+                -> GHandler site (Maybe (Route site))
 maybeAuthorized r isWrite = do
     x <- isAuthorized r isWrite
     return $ if x == Authorized then Just r else Nothing
 
-class (MonadResource m, HandlerState m, Yesod (HandlerBase m)) => MonadHandlerBase m where
+defaultLayoutT :: ( HandlerSite m ~ sub
-    type HandlerBase m
+                  , Yesod (HandlerMaster m)
-    type HandlerSite m
+                  , MonadHandler m
-    liftHandler :: GHandler (HandlerBase m) (HandlerBase m) a -> m a
-    askHandlerData :: m (HandlerData (HandlerSite m) (HandlerSite m))
-instance Yesod master => MonadHandlerBase (GHandler master master) where
-    type HandlerBase (GHandler master master) = master
-    type HandlerSite (GHandler master master) = master
-    liftHandler = id
-    askHandlerData = GHandler return
-instance MonadHandlerBase m => MonadHandlerBase (HandlerT sub m) where
-    type HandlerBase (HandlerT sub m) = HandlerBase m
-    type HandlerSite (HandlerT sub m) = sub
-    liftHandler = lift . liftHandler
-    askHandlerData = HandlerT return
-
-defaultLayoutT :: ( HandlerState m
-                  , HandlerSite m ~ sub
-                  , Yesod (HandlerBase m)
-                  , MonadHandlerBase m
-                  , MonadResource m
                   )
-               => GWidget sub sub ()
+               => GWidget sub ()
                -> m RepHtml
 defaultLayoutT (GWidget (GHandler f)) = do
     hd <- askHandlerData

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

@@ -8,14 +8,14 @@ import Data.Text (Text)
 -- | A type-safe, concise method of creating breadcrumbs for pages. For each
 -- resource, you declare the title of the page and the parent resource (if
 -- present).
-class YesodBreadcrumbs y where
+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 y -> GHandler sub y (Text , Maybe (Route y))
+    breadcrumb :: Route site -> GHandler 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 y => GHandler sub y (Text, [(Route y, Text)])
+breadcrumbs :: YesodBreadcrumbs site => GHandler site (Text, [(Route site, Text)])
 breadcrumbs = do
     x <- getCurrentRoute
     case x of

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

@@ -18,56 +18,36 @@ import           Control.Monad.Trans.Control  (MonadBaseControl)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
-class YesodDispatch sub master where
+class Yesod site => YesodDispatch site where
-    yesodDispatch
+    yesodDispatch :: YesodRunnerEnv site -> W.Application
-        :: Yesod master
-        => YesodRunnerEnv sub master
-        -> W.Application
-
-instance YesodDispatch WaiSubsite master where
-    yesodDispatch YesodRunnerEnv { yreSub = WaiSubsite app } req =
-        app req
 
 class YesodSubDispatch sub m where
     yesodSubDispatch
-        :: (HandlerError m, HandlerState m, master ~ HandlerMaster m, Yesod master, MonadBaseControl IO m)
+        :: (MonadHandler m, master ~ HandlerMaster m, Yesod master)
         => (m TypedContent
-                -> YesodRunnerEnv master master
+                -> YesodRunnerEnv master
                 -> Maybe (Route master)
                 -> W.Application)
         -> (master -> sub)
         -> (Route sub -> Route master)
-        -> YesodRunnerEnv master master
+        -> YesodRunnerEnv master
         -> W.Application
 
 instance YesodSubDispatch WaiSubsite master where
-    yesodSubDispatch _ toSub _ YesodRunnerEnv { yreMaster = master } req =
+    yesodSubDispatch _ toSub _ YesodRunnerEnv { yreSite = site } req =
         app req
       where
-        WaiSubsite app = toSub master
+        WaiSubsite app = toSub site
 
-{-
+subHelper :: (HandlerSite m ~ master, MonadHandler m)
-subHelper :: Yesod master => (YesodRunnerEnv sub master -> W.Application)
-        -> (forall res. ToTypedContent res
-                => m res
-                -> YesodRunnerEnv master master
-                -> Maybe (Route master)
-                -> W.Application)
-        -> (master -> sub)
-        -> (Route sub -> Route master)
-        -> W.Application
-subHelper runBase getSub toMaster = error "subHelper"
--}
-
-subHelper :: (HandlerMaster m ~ master, HandlerState m, MonadBaseControl IO m)
           => (m TypedContent
-                -> YesodRunnerEnv master master
+                -> YesodRunnerEnv master
                 -> Maybe (Route master)
                 -> W.Application)
           -> (master -> sub)
           -> (Route sub -> Route master)
           -> HandlerT sub m TypedContent
-          -> YesodRunnerEnv master master
+          -> YesodRunnerEnv master
           -> Maybe (Route sub)
           -> W.Application
 subHelper parentRunner getSub toMaster handlert env route =

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

@@ -5,35 +5,38 @@
 module Yesod.Core.Class.Handler where
 
 import Yesod.Core.Types
+import Yesod.Core.Types.Orphan ()
 import Yesod.Core.Class.MonadLift (lift)
 import Control.Monad.Trans.Class (MonadTrans)
+import Control.Monad.Trans.Resource
+import Control.Monad.Trans.Control
 import Data.IORef.Lifted (atomicModifyIORef)
 import Control.Exception.Lifted (throwIO)
 
 class Monad m => HandlerReader m where
-    type HandlerSub m
+    type HandlerSite m
     type HandlerMaster m
 
     askYesodRequest :: m YesodRequest
-    askHandlerEnv :: m (RunHandlerEnv (HandlerSub m) (HandlerMaster m))
+    askHandlerEnv :: m (RunHandlerEnv (HandlerSite m))
 
-instance HandlerReader (GHandler sub master) where
+instance HandlerReader (GHandler site) where
-    type HandlerSub (GHandler sub master) = sub
+    type HandlerSite (GHandler site) = site
-    type HandlerMaster (GHandler sub master) = master
+    type HandlerMaster (GHandler site) = site
 
     askYesodRequest = GHandler $ return . handlerRequest
     askHandlerEnv = GHandler $ return . handlerEnv
 
-instance HandlerReader (GWidget sub master) where
+instance HandlerReader m => HandlerReader (HandlerT site m) where
-    type HandlerSub (GWidget sub master) = sub
+    type HandlerSite (HandlerT site m) = site
-    type HandlerMaster (GWidget sub master) = master
+    type HandlerMaster (HandlerT site m) = HandlerMaster m
 
-    askYesodRequest = lift askYesodRequest
+    askYesodRequest = HandlerT $ return . handlerRequest
-    askHandlerEnv = lift askHandlerEnv
+    askHandlerEnv = HandlerT $ return . handlerEnv
 
-instance (MonadTrans t, HandlerReader m, Monad (t m)) => HandlerReader (t m) where
+instance HandlerReader (GWidget site) where
-    type HandlerSub (t m) = HandlerSub m
+    type HandlerSite (GWidget site) = site
-    type HandlerMaster (t m) = HandlerMaster m
+    type HandlerMaster (GWidget site) = site
 
     askYesodRequest = lift askYesodRequest
     askHandlerEnv = lift askHandlerEnv
@@ -47,26 +50,26 @@ class HandlerReader m => HandlerState m where
     putGHState :: GHState -> m ()
     putGHState s = stateGHState $ const ((), s)
 
-instance HandlerState (GHandler sub master) where
+instance HandlerState (GHandler site) where
     stateGHState f =
         GHandler $ flip atomicModifyIORef f' . handlerState
       where
         f' z = let (x, y) = f z in (y, x)
 
-instance HandlerState (GWidget sub master) where
+instance HandlerState (GWidget site) where
     stateGHState = lift . stateGHState
 
-instance (MonadTrans t, HandlerState m, Monad (t m)) => HandlerState (t m) where
+instance HandlerState m => HandlerState (HandlerT site m) where
     stateGHState = lift . stateGHState
 
 class HandlerReader m => HandlerError m where
     handlerError :: HandlerContents -> m a
 
-instance HandlerError (GHandler sub master) where
+instance HandlerError (GHandler site) where
     handlerError = throwIO
 
-instance HandlerError (GWidget sub master) where
+instance HandlerError (GWidget site) where
     handlerError = lift . handlerError
 
-instance (HandlerError m, MonadTrans t, Monad (t m)) => HandlerError (t m) where
+instance HandlerError m => HandlerError (HandlerT site m) where
     handlerError = lift . handlerError

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

@@ -6,7 +6,8 @@ module Yesod.Core.Class.Yesod where
 
 import           Control.Monad.Logger               (logErrorS)
 import           Yesod.Core.Content
-import           Yesod.Core.Handler                 hiding (getExpires)
+import           Yesod.Core.Handler
+import           Yesod.Core.Class.Handler
 
 import           Yesod.Routes.Class
 
@@ -17,6 +18,8 @@ import           Control.Monad                      (forM)
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelOther),
                                                      LogSource)
+import Control.Monad.Trans.Resource
+import Control.Monad.Trans.Control
 import qualified Data.ByteString.Char8              as S8
 import qualified Data.ByteString.Lazy               as L
 import Data.Aeson (object, (.=))
@@ -77,11 +80,11 @@ class RenderRoute a => Yesod a where
     approot = ApprootRelative
 
     -- | Output error response pages.
-    errorHandler :: ErrorResponse -> GHandler sub a TypedContent
+    errorHandler :: ErrorResponse -> GHandler a TypedContent
     errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
+    defaultLayout :: GWidget a () -> GHandler a RepHtml
     defaultLayout w = do
         p <- widgetToPageContent w
         mmsg <- getMessage
@@ -112,7 +115,7 @@ $doctype 5
     -- If authentication is required, return 'AuthenticationRequired'.
     isAuthorized :: Route a
                  -> Bool -- ^ is this a write request?
-                 -> GHandler s a AuthResult
+                 -> GHandler a AuthResult
     isAuthorized _ _ = return Authorized
 
     -- | Determines whether the current request is a write request. By default,
@@ -122,7 +125,7 @@ $doctype 5
     --
     -- This function is used to determine if a request is authorized; see
     -- 'isAuthorized'.
-    isWriteRequest :: Route a -> GHandler s a Bool
+    isWriteRequest :: Route a -> GHandler a Bool
     isWriteRequest _ = do
         wai <- waiRequest
         return $ W.requestMethod wai `notElem`
@@ -188,7 +191,7 @@ $doctype 5
     addStaticContent :: Text -- ^ filename extension
                      -> Text -- ^ mime-type
                      -> L.ByteString -- ^ content
-                     -> GHandler sub a (Maybe (Either Text (Route a, [(Text, Text)])))
+                     -> GHandler a (Maybe (Either Text (Route a, [(Text, Text)])))
     addStaticContent _ _ _ = return Nothing
 
     {- Temporarily disabled until we have a better interface.
@@ -274,7 +277,7 @@ $doctype 5
     -- performs authorization checks.
     --
     -- Since: 1.1.6
-    yesodMiddleware :: GHandler sub a res -> GHandler sub a res
+    yesodMiddleware :: GHandler a res -> GHandler a res
     yesodMiddleware handler = do
         setHeader "Vary" "Accept, Accept-Language"
         route <- getCurrentRoute
@@ -297,9 +300,9 @@ $doctype 5
                 handler
 
 -- | Convert a widget to a 'PageContent'.
-widgetToPageContent :: (Eq (Route master), Yesod master)
+widgetToPageContent :: (Eq (Route site), Yesod site)
-                    => GWidget sub master ()
+                    => GWidget site ()
-                    -> GHandler sub master (PageContent (Route master))
+                    -> GHandler site (PageContent (Route site))
 widgetToPageContent w = do
     master <- getYesod
     ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- unGWidget w
@@ -393,7 +396,7 @@ $newline never
     runUniqueList (UniqueList x) = nub $ x []
 
 -- | The default error handler for 'errorHandler'.
-defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y TypedContent
+defaultErrorHandler :: Yesod site => ErrorResponse -> GHandler site TypedContent
 defaultErrorHandler NotFound = selectRep $ do
     provideRep $ defaultLayout $ do
         r <- lift waiRequest
@@ -557,3 +560,14 @@ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
   where
     line = show . fst . loc_start
     char = show . snd . loc_start
+
+class (MonadBaseControl IO m, HandlerState m, HandlerError m, MonadResource m, Yesod (HandlerMaster m)) => MonadHandler m where
+    liftHandler :: GHandler (HandlerMaster m) a -> m a
+    askHandlerData :: m (HandlerData (HandlerSite m))
+
+instance Yesod site => MonadHandler (GHandler site) where
+    liftHandler = id
+    askHandlerData = GHandler return
+instance MonadHandler m => MonadHandler (HandlerT site m) where
+    liftHandler = lift . liftHandler
+    askHandlerData = HandlerT return

yesod-core/Yesod/Core/Dispatch.hs

@@ -122,8 +122,8 @@ mkYesodGeneral name args clazzes isSub resS = do
         context = if isSub then cxt $ yesod : map return clazzes
                            else return []
         yesod   = classP ''HandlerReader [master]
-        handler = tySynD (mkName "Handler") [] [t| GHandler $master $master    |]
+        handler = tySynD (mkName "Handler") [] [t| GHandler $master    |]
-        widget  = tySynD (mkName "Widget")  [] [t| GWidget  $master $master () |]
+        widget  = tySynD (mkName "Widget")  [] [t| GWidget  $master () |]
         res     = map (fmap parseType) resS
         subCons = conT $ mkName name
         subArgs = map (varT. mkName) args
@@ -139,7 +139,7 @@ mkDispatchInstance :: CxtQ                -- ^ The context
                    -> [ResourceTree a]    -- ^ The resource
                    -> DecsQ
 mkDispatchInstance context _sub master res = do
-  let yDispatch = conT ''YesodDispatch `appT` master `appT` master
+  let yDispatch = conT ''YesodDispatch `appT` master
       thisDispatch = do
             clause' <- mkDispatchClause MkDispatchSettings
                 { mdsRunHandler = [|yesodRunner|]
@@ -199,38 +199,30 @@ mkYesodSubDispatch res = do
 -- handler. This is the same as 'toWaiAppPlain', except it includes two
 -- middlewares: GZIP compression and autohead. This is the
 -- recommended approach for most users.
-toWaiApp :: ( Yesod master
+toWaiApp :: YesodDispatch site => site -> IO W.Application
-            , YesodDispatch master master
-            ) => master -> IO W.Application
 toWaiApp y = gzip (gzipSettings y) . autohead <$> toWaiAppPlain y
 
 -- | Convert the given argument into a WAI application, executable with any WAI
 -- handler. This differs from 'toWaiApp' in that it uses no middlewares.
-toWaiAppPlain :: ( Yesod master
+toWaiAppPlain :: YesodDispatch site => site -> IO W.Application
-                 , YesodDispatch master master
-                 ) => master -> IO W.Application
 toWaiAppPlain a = toWaiApp' a <$> getLogger a <*> makeSessionBackend a
 
 
-toWaiApp' :: ( Yesod master
+toWaiApp' :: YesodDispatch site
-             , YesodDispatch master master
+          => site
-             )
-          => master
           -> Logger
           -> Maybe SessionBackend
           -> W.Application
-toWaiApp' y logger sb req =
+toWaiApp' site logger sb req =
-    case cleanPath y $ W.pathInfo req of
+    case cleanPath site $ W.pathInfo req of
-        Left pieces -> sendRedirect y pieces req
+        Left pieces -> sendRedirect site pieces req
         Right pieces -> yesodDispatch yre req
             { W.pathInfo = pieces
             }
   where
     yre = YesodRunnerEnv
         { yreLogger = logger
-        , yreMaster = y
+        , yreSite = site
-        , yreSub = y
-        , yreToMaster = id
         , yreSessionBackend = sb
         }
 

yesod-core/Yesod/Core/Handler.hs

@@ -25,12 +25,9 @@ module Yesod.Core.Handler
     , HandlerT
       -- ** Read information from handler
     , getYesod
-    , getYesodSub
     , getUrlRender
     , getUrlRenderParams
     , getCurrentRoute
-    , getCurrentRouteSub
-    , getRouteToMaster
     , getRequest
     , waiRequest
     , runRequestBody
@@ -132,7 +129,7 @@ import           Yesod.Core.Internal.Request   (langKey, mkFileInfoFile,
 
 import           Control.Applicative           ((<$>), (<|>))
 
-import           Control.Monad                 (ap, liftM)
+import           Control.Monad                 (liftM)
 import qualified Control.Monad.Trans.Writer    as Writer
 
 import           Control.Monad.IO.Class        (MonadIO, liftIO)
@@ -233,16 +230,12 @@ rbHelper' backend mkFI req =
             | otherwise = a'
     go = decodeUtf8With lenientDecode
 
--- | Get the sub application argument.
-getYesodSub :: HandlerReader m => m (HandlerSub m)
-getYesodSub = rheSub `liftM` askHandlerEnv
-
 -- | Get the master site appliation argument.
-getYesod :: HandlerReader m => m (HandlerMaster m)
+getYesod :: HandlerReader m => m (HandlerSite m)
-getYesod = rheMaster `liftM` askHandlerEnv
+getYesod = rheSite `liftM` askHandlerEnv
 
 -- | Get the URL rendering function.
-getUrlRender :: HandlerReader m => m (Route (HandlerMaster m) -> Text)
+getUrlRender :: HandlerReader m => m (Route (HandlerSite m) -> Text)
 getUrlRender = do
     x <- rheRender `liftM` askHandlerEnv
     return $ flip x []
@@ -250,23 +243,13 @@ getUrlRender = do
 -- | The URL rendering function with query-string parameters.
 getUrlRenderParams
     :: HandlerReader m
-    => m (Route (HandlerMaster m) -> [(Text, Text)] -> Text)
+    => m (Route (HandlerSite m) -> [(Text, Text)] -> Text)
 getUrlRenderParams = rheRender `liftM` askHandlerEnv
 
 -- | Get the route requested by the user. If this is a 404 response- where the
 -- user requested an invalid route- this function will return 'Nothing'.
-getCurrentRoute :: HandlerReader m => m (Maybe (Route (HandlerMaster m)))
+getCurrentRoute :: HandlerReader m => m (Maybe (Route (HandlerSite m)))
-getCurrentRoute = fmap `liftM` getRouteToMaster `ap` getCurrentRouteSub
+getCurrentRoute = rheRoute `liftM` askHandlerEnv
-
--- | Same as 'getCurrentRoute', but for the subsite.
-getCurrentRouteSub :: HandlerReader m => m (Maybe (Route (HandlerSub m)))
-getCurrentRouteSub = rheRoute `liftM` askHandlerEnv
-
--- | Get the function to promote a route for a subsite to a route for the
--- master site.
-getRouteToMaster :: HandlerReader m => m (Route (HandlerSub m) -> Route (HandlerMaster m))
-getRouteToMaster = rheToMaster `liftM` askHandlerEnv
-
 
 -- | Returns a function that runs 'GHandler' actions inside @IO@.
 --
@@ -304,7 +287,7 @@ getRouteToMaster = rheToMaster `liftM` 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 m => GHandler sub master (GHandler sub master a -> m a)
+handlerToIO :: MonadIO m => GHandler site (GHandler site a -> m a)
 handlerToIO =
   GHandler $ \oldHandlerData -> do
     -- Let go of the request body, cache and response headers.
@@ -344,7 +327,7 @@ handlerToIO =
 --
 -- If you want direct control of the final status code, or need a different
 -- status code, please use 'redirectWith'.
-redirect :: (HandlerError m, RedirectUrl (HandlerMaster m) url, HandlerReader m)
+redirect :: (HandlerError m, RedirectUrl (HandlerSite m) url, HandlerReader m)
          => url -> m a
 redirect url = do
     req <- waiRequest
@@ -355,7 +338,7 @@ redirect url = do
     redirectWith status url
 
 -- | Redirect to the given URL with the specified status code.
-redirectWith :: (HandlerError m, RedirectUrl (HandlerMaster m) url, HandlerReader m)
+redirectWith :: (HandlerError m, RedirectUrl (HandlerSite m) url, HandlerReader m)
              => H.Status
              -> url
              -> m a
@@ -370,7 +353,7 @@ ultDestKey = "_ULT"
 --
 -- An ultimate destination is stored in the user session and can be loaded
 -- later by 'redirectUltDest'.
-setUltDest :: (HandlerState m, RedirectUrl (HandlerMaster m) url)
+setUltDest :: (HandlerState m, RedirectUrl (HandlerSite m) url)
            => url
            -> m ()
 setUltDest url = do
@@ -410,7 +393,7 @@ setUltDestReferer = do
 --
 -- This function uses 'redirect', and thus will perform a temporary redirect to
 -- a GET request.
-redirectUltDest :: (RedirectUrl (HandlerMaster m) url, HandlerState m, HandlerError m)
+redirectUltDest :: (RedirectUrl (HandlerSite m) url, HandlerState m, HandlerError m)
                 => url -- ^ default destination if nothing in session
                 -> m a
 redirectUltDest def = do
@@ -434,7 +417,7 @@ setMessage = setSession msgKey . T.concat . TL.toChunks . RenderText.renderHtml
 -- | Sets a message in the user's session.
 --
 -- See 'getMessage'.
-setMessageI :: (HandlerState m, RenderMessage (HandlerMaster m) msg)
+setMessageI :: (HandlerState m, RenderMessage (HandlerSite m) msg)
             => msg -> m ()
 setMessageI msg = do
     mr <- getMessageRender
@@ -479,7 +462,7 @@ sendResponseStatus s = handlerError . HCContent s . toTypedContent
 
 -- | Send a 201 "Created" response with the given route as the Location
 -- response header.
-sendResponseCreated :: HandlerError m => Route (HandlerMaster m) -> m a
+sendResponseCreated :: HandlerError m => Route (HandlerSite m) -> m a
 sendResponseCreated url = do
     r <- getUrlRender
     handlerError $ HCCreated $ r url
@@ -507,7 +490,7 @@ permissionDenied :: HandlerError m => Text -> m a
 permissionDenied = hcError . PermissionDenied
 
 -- | Return a 403 permission denied page.
-permissionDeniedI :: (RenderMessage (HandlerMaster m) msg, HandlerError m)
+permissionDeniedI :: (RenderMessage (HandlerSite m) msg, HandlerError m)
                   => msg
                   -> m a
 permissionDeniedI msg = do
@@ -519,7 +502,7 @@ invalidArgs :: HandlerError m => [Text] -> m a
 invalidArgs = hcError . InvalidArgs
 
 -- | Return a 400 invalid arguments page.
-invalidArgsI :: (HandlerError m, RenderMessage (HandlerMaster m) msg) => [msg] -> m a
+invalidArgsI :: (HandlerError m, RenderMessage (HandlerSite m) msg) => [msg] -> m a
 invalidArgsI msg = do
     mr <- getMessageRender
     invalidArgs $ map mr msg
@@ -623,7 +606,7 @@ addHeader = tell . Endo . (:)
 -- | Some value which can be turned into a URL for redirects.
 class RedirectUrl master a where
     -- | Converts the value to the URL and a list of query-string parameters.
-    toTextUrl :: (HandlerReader m, HandlerMaster m ~ master) => a -> m Text
+    toTextUrl :: (HandlerReader m, HandlerSite m ~ master) => a -> m Text
 
 instance RedirectUrl master Text where
     toTextUrl = return
@@ -672,7 +655,7 @@ newIdent = do
 -- POST form, and some Javascript to automatically submit the form. This can be
 -- useful when you need to post a plain link somewhere that needs to cause
 -- changes on the server.
-redirectToPost :: (HandlerError m, RedirectUrl (HandlerMaster m) url)
+redirectToPost :: (HandlerError m, RedirectUrl (HandlerSite m) url)
                => url
                -> m a
 redirectToPost url = do
@@ -692,7 +675,7 @@ $doctype 5
 |] >>= sendResponse
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: HandlerReader m => HtmlUrl (Route (HandlerMaster m)) -> m Html
+hamletToRepHtml :: HandlerReader m => HtmlUrl (Route (HandlerSite m)) -> m Html
 hamletToRepHtml = giveUrlRenderer
 
 -- | Provide a URL rendering function to the given function and return the
@@ -700,7 +683,7 @@ hamletToRepHtml = giveUrlRenderer
 --
 -- Since 1.2.0
 giveUrlRenderer :: HandlerReader m
-                => ((Route (HandlerMaster m) -> [(Text, Text)] -> Text) -> output)
+                => ((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output)
                 -> m output
 giveUrlRenderer f = do
     render <- getUrlRenderParams
@@ -710,7 +693,7 @@ giveUrlRenderer f = do
 waiRequest :: HandlerReader m => m W.Request
 waiRequest = reqWaiRequest `liftM` getRequest
 
-getMessageRender :: (HandlerReader m, RenderMessage (HandlerMaster m) message)
+getMessageRender :: (HandlerReader m, RenderMessage (HandlerSite m) message)
                  => m (message -> Text)
 getMessageRender = do
     m <- getYesod

yesod-core/Yesod/Core/Internal/Run.hs

@@ -11,10 +11,9 @@ import Yesod.Core.Class.Handler
 import           Blaze.ByteString.Builder     (toByteString)
 import           Control.Applicative          ((<$>))
 import           Control.Exception            (fromException)
-import           Control.Exception.Lifted     (catch, finally)
+import           Control.Exception.Lifted     (catch)
 import           Control.Monad.IO.Class       (MonadIO)
 import           Control.Monad.IO.Class       (liftIO)
-import           Control.Monad.Base           (liftBase)
 import           Control.Monad.Logger         (LogLevel (LevelError), LogSource,
                                                liftLoc)
 import           Control.Monad.Trans.Resource (runResourceT)
@@ -48,8 +47,8 @@ import           Yesod.Routes.Class           (Route, renderRoute)
 -- | Function used internally by Yesod in the process of converting a
 -- 'GHandler' into an 'Application'. Should not be needed by users.
 runHandler :: ToTypedContent c
-           => RunHandlerEnv sub master
+           => RunHandlerEnv site
-           -> GHandler sub master c
+           -> GHandler site c
            -> YesodApp
 runHandler rhe@RunHandlerEnv {..} handler yreq = do
     let toErrorHandler e =
@@ -149,25 +148,23 @@ safeEh log' er req = do
 -- @GHandler@ is completely ignored, including changes to the
 -- session, cookies or headers.  We only return you the
 -- @GHandler@'s return value.
-runFakeHandler :: (Yesod master, MonadIO m) =>
+runFakeHandler :: (Yesod site, MonadIO m) =>
                   SessionMap
-               -> (master -> Logger)
+               -> (site -> Logger)
-               -> master
+               -> site
-               -> GHandler master master a
+               -> GHandler site a
                -> m (Either ErrorResponse a)
-runFakeHandler fakeSessionMap logger master handler = liftIO $ do
+runFakeHandler fakeSessionMap logger site handler = liftIO $ do
   ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")
   let handler' = do liftIO . I.writeIORef ret . Right =<< handler
                     return ()
   let yapp = runHandler
          RunHandlerEnv
-            { rheRender = yesodRender master $ resolveApproot master fakeWaiRequest
+            { rheRender = yesodRender site $ resolveApproot site fakeWaiRequest
             , rheRoute = Nothing
-            , rheToMaster = id
+            , rheSite = site
-            , rheMaster = master
+            , rheUpload = fileUpload site
-            , rheSub = master
+            , rheLog = messageLoggerSource site $ logger site
-            , rheUpload = fileUpload master
-            , rheLog = messageLoggerSource master $ logger master
             , rheOnError = errHandler
             }
         handler'
@@ -210,10 +207,10 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
   I.readIORef ret
 {-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-}
 
-yesodRunner :: (ToTypedContent res, Yesod master)
+yesodRunner :: (ToTypedContent res, Yesod site)
-            => GHandler sub master res
+            => GHandler site res
-            -> YesodRunnerEnv sub master
+            -> YesodRunnerEnv site
-            -> Maybe (Route sub)
+            -> Maybe (Route site)
             -> Application
 yesodRunner handler' YesodRunnerEnv {..} route req
   | KnownLength len <- requestBodyLength req, maxLen < len = return tooLargeResponse
@@ -226,19 +223,17 @@ yesodRunner handler' YesodRunnerEnv {..} route req
         case mkYesodReq of
             Left yreq -> return yreq
             Right needGen -> liftIO $ needGen <$> newStdGen
-    let ra = resolveApproot yreMaster req
+    let ra = resolveApproot yreSite req
-    let log' = messageLoggerSource yreMaster yreLogger
+    let log' = messageLoggerSource yreSite yreLogger
         -- We set up two environments: the first one has a "safe" error handler
         -- which will never throw an exception. The second one uses the
         -- user-provided errorHandler function. If that errorHandler function
         -- errors out, it will use the safeEh below to recover.
         rheSafe = RunHandlerEnv
-            { rheRender = yesodRender yreMaster ra
+            { rheRender = yesodRender yreSite ra
             , rheRoute = route
-            , rheToMaster = yreToMaster
+            , rheSite = yreSite
-            , rheMaster = yreMaster
+            , rheUpload = fileUpload yreSite
-            , rheSub = yreSub
-            , rheUpload = fileUpload yreMaster
             , rheLog = log'
             , rheOnError = safeEh log'
             }
@@ -248,7 +243,7 @@ yesodRunner handler' YesodRunnerEnv {..} route req
     yar <- runHandler rhe handler yreq
     liftIO $ yarToResponse yar saveSession yreq
   where
-    maxLen = maximumContentLength yreMaster $ fmap yreToMaster route
+    maxLen = maximumContentLength yreSite route
     handler = yesodMiddleware handler'
 
 yesodRender :: Yesod y
@@ -274,38 +269,20 @@ resolveApproot master req =
         ApprootMaster f -> f master
         ApprootRequest f -> f master req
 
-fixEnv :: (oldSub -> newSub)
+stripHandlerT :: (MonadHandler m, MonadBaseControl IO m)
-       -> (Route newSub -> Route oldSub)
-       -> YesodRunnerEnv oldSub master
-       -> YesodRunnerEnv newSub master
-fixEnv toNewSub toOldRoute envOld =
-    envOld
-        { yreSub = toNewSub $ yreSub envOld
-        , yreToMaster = yreToMaster envOld . toOldRoute
-        }
-
-stripHandlerT :: (HandlerState m, MonadBaseControl IO m)
               => HandlerT sub m a
-              -> (HandlerMaster m -> sub)
+              -> (HandlerSite m -> sub)
-              -> (Route sub -> Route (HandlerMaster m))
+              -> (Route sub -> Route (HandlerSite m))
               -> Maybe (Route sub)
               -> m a
 stripHandlerT (HandlerT f) getSub toMaster newRoute = do
-    yreq <- askYesodRequest
+    hd <- askHandlerData
-    env <- askHandlerEnv
-    ghs <- getGHState
-    ighs <- liftBase $ I.newIORef ghs
 
-    let sub = getSub $ rheMaster env
+    let env = handlerEnv hd
-        hd = HandlerData
+    f hd
-            { handlerRequest = yreq
+        { handlerEnv = env
-            , handlerEnv = env
+            { rheSite = getSub $ rheSite env
-                { rheMaster = sub
+            , rheRoute = newRoute
-                , rheSub = sub
+            , rheRender = \url params -> rheRender env (toMaster url) params
-                , rheToMaster = id
-                , rheRoute = newRoute
-                , rheRender = \url params -> rheRender env (toMaster url) params
-                }
-            , handlerState = ighs
             }
-    f hd `finally` (liftBase (I.readIORef ighs) >>= putGHState)
+        }

yesod-core/Yesod/Core/Json.hs

@@ -44,10 +44,10 @@ import Data.Maybe (listToMaybe)
 -- ('defaultLayout').
 --
 -- /Since: 0.3.0/
-defaultLayoutJson :: (Yesod master, J.ToJSON a)
+defaultLayoutJson :: (Yesod site, J.ToJSON a)
-                  => GWidget sub master ()  -- ^ HTML
+                  => GWidget site ()  -- ^ HTML
-                  -> GHandler sub master a  -- ^ JSON
+                  -> GHandler site a  -- ^ JSON
-                  -> GHandler sub master TypedContent
+                  -> GHandler site TypedContent
 defaultLayoutJson w json = selectRep $ do
     provideRep $ defaultLayout w
     provideRep $ fmap J.toJSON json
@@ -56,7 +56,7 @@ defaultLayoutJson w json = selectRep $ do
 -- support conversion to JSON via 'J.ToJSON'.
 --
 -- /Since: 0.3.0/
-jsonToRepJson :: J.ToJSON a => a -> GHandler sub master J.Value
+jsonToRepJson :: J.ToJSON a => a -> GHandler site J.Value
 jsonToRepJson = return . J.toJSON
 
 -- | Parse the request body to a data type as a JSON value.  The
@@ -65,7 +65,7 @@ jsonToRepJson = return . J.toJSON
 -- 'J.Value'@.
 --
 -- /Since: 0.3.0/
-parseJsonBody :: J.FromJSON a => GHandler sub master (J.Result a)
+parseJsonBody :: J.FromJSON a => GHandler site (J.Result a)
 parseJsonBody = do
     req <- waiRequest
     eValue <- lift
@@ -78,7 +78,7 @@ parseJsonBody = do
 
 -- | Same as 'parseJsonBody', but return an invalid args response on a parse
 -- error.
-parseJsonBody_ :: J.FromJSON a => GHandler sub master a
+parseJsonBody_ :: J.FromJSON a => GHandler site a
 parseJsonBody_ = do
     ra <- parseJsonBody
     case ra of
@@ -96,10 +96,10 @@ array = J.Array . V.fromList . map J.toJSON
 --     @application\/json@ (e.g. AJAX, see 'acceptsJSON').
 --
 --     2. 3xx otherwise, following the PRG pattern.
-jsonOrRedirect :: (Yesod master, J.ToJSON a)
+jsonOrRedirect :: (Yesod site, J.ToJSON a)
-               => Route master -- ^ Redirect target
+               => Route site   -- ^ Redirect target
                -> a            -- ^ Data to send via JSON
-               -> GHandler sub master J.Value
+               -> GHandler site J.Value
 jsonOrRedirect r j = do
     q <- acceptsJson
     if q then jsonToRepJson (J.toJSON j)
@@ -107,7 +107,7 @@ jsonOrRedirect r j = do
 
 -- | Returns @True@ if the client prefers @application\/json@ as
 -- indicated by the @Accept@ HTTP header.
-acceptsJson :: Yesod master => GHandler sub master Bool
+acceptsJson :: Yesod site => GHandler site Bool
 acceptsJson =  maybe False ((== "application/json") . B8.takeWhile (/= ';'))
             .  join
             .  fmap (listToMaybe . parseHttpAccept)

yesod-core/Yesod/Core/Types.hs

@@ -166,12 +166,10 @@ type Texts = [Text]
 -- | Wrap up a normal WAI application as a Yesod subsite.
 newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
 
-data RunHandlerEnv sub master = RunHandlerEnv
+data RunHandlerEnv site = RunHandlerEnv
-    { rheRender   :: !(Route master -> [(Text, Text)] -> Text)
+    { rheRender   :: !(Route site -> [(Text, Text)] -> Text)
-    , rheRoute    :: !(Maybe (Route sub))
+    , rheRoute    :: !(Maybe (Route site))
-    , rheToMaster :: !(Route sub -> Route master)
+    , rheSite     :: !site
-    , rheMaster   :: !master
-    , rheSub      :: !sub
     , rheUpload   :: !(RequestBodyLength -> FileUpload)
     , rheLog      :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
     , rheOnError  :: !(ErrorResponse -> YesodApp)
@@ -180,28 +178,26 @@ data RunHandlerEnv sub master = RunHandlerEnv
       -- Since 1.2.0
     }
 
-data HandlerData sub master = HandlerData
+data HandlerData site = HandlerData
     { handlerRequest :: !YesodRequest
-    , handlerEnv     :: !(RunHandlerEnv sub master)
+    , handlerEnv     :: !(RunHandlerEnv site)
     , handlerState   :: !(IORef GHState)
     }
 
-data YesodRunnerEnv sub master = YesodRunnerEnv
+data YesodRunnerEnv site = YesodRunnerEnv
     { yreLogger         :: !Logger
-    , yreMaster         :: !master
+    , yreSite           :: !site
-    , yreSub            :: !sub
-    , yreToMaster       :: !(Route sub -> Route master)
     , yreSessionBackend :: !(Maybe SessionBackend)
     }
 
 -- | A generic handler monad, which can have a different subsite and master
 -- site. We define a newtype for better error message.
-newtype GHandler sub master a = GHandler
+newtype GHandler site a = GHandler
-    { unGHandler :: HandlerData sub master -> ResourceT IO a
+    { unGHandler :: HandlerData site -> ResourceT IO a
     }
 
-newtype HandlerT sub m a = HandlerT
+newtype HandlerT site m a = HandlerT
-    { unHandlerT :: HandlerData sub sub -> m a
+    { unHandlerT :: HandlerData site -> m a
     }
 
 instance Monad m => Monad (HandlerT sub m) where
@@ -229,11 +225,11 @@ 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 GWidget sub master a = GWidget
+newtype GWidget site a = GWidget -- FIXME change to WidgetT?
-    { unGWidget :: GHandler sub master (a, GWData (Route master))
+    { unGWidget :: GHandler site (a, GWData (Route site))
     }
 
-instance (a ~ ()) => Monoid (GWidget sub master a) where
+instance (a ~ ()) => Monoid (GWidget site a) where
     mempty = return ()
     mappend x y = x >> y
 
@@ -349,60 +345,60 @@ instance Show HandlerContents where
 instance Exception HandlerContents
 
 -- Instances for GWidget
-instance Functor (GWidget sub master) where
+instance Functor (GWidget site) where
     fmap f (GWidget x) = GWidget (fmap (first f) x)
-instance Applicative (GWidget sub master) where
+instance Applicative (GWidget site) where
     pure a = GWidget $ pure (a, mempty)
     GWidget f <*> GWidget v =
         GWidget $ k <$> f <*> v
       where
         k (a, wa) (b, wb) = (a b, wa `mappend` wb)
-instance Monad (GWidget sub master) where
+instance Monad (GWidget site) where
     return = pure
     GWidget x >>= f = GWidget $ do
         (a, wa) <- x
         (b, wb) <- unGWidget (f a)
         return (b, wa `mappend` wb)
-instance MonadIO (GWidget sub master) where
+instance MonadIO (GWidget site) where
     liftIO = GWidget . fmap (\a -> (a, mempty)) . liftIO
-instance MonadBase IO (GWidget sub master) where
+instance MonadBase IO (GWidget site) where
     liftBase = GWidget . fmap (\a -> (a, mempty)) . liftBase
-instance MonadBaseControl IO (GWidget sub master) where
+instance MonadBaseControl IO (GWidget site) where
-    data StM (GWidget sub master) a =
+    data StM (GWidget site) a =
-        StW (StM (GHandler sub master) (a, GWData (Route master)))
+        StW (StM (GHandler site) (a, GWData (Route site)))
     liftBaseWith f = GWidget $ liftBaseWith $ \runInBase ->
         liftM (\x -> (x, mempty))
         (f $ liftM StW . runInBase . unGWidget)
     restoreM (StW base) = GWidget $ restoreM base
 
-instance MonadUnsafeIO (GWidget sub master) where
+instance MonadUnsafeIO (GWidget site) where
     unsafeLiftIO = liftIO
-instance MonadThrow (GWidget sub master) where
+instance MonadThrow (GWidget site) where
     monadThrow = liftIO . throwIO
-instance MonadResource (GWidget sub master) where
+instance MonadResource (GWidget site) where
     liftResourceT = lift . liftResourceT
 
-instance MonadLogger (GWidget sub master) where
+instance MonadLogger (GWidget site) where
     monadLoggerLog a b c = lift . monadLoggerLog a b c
 
-instance MonadLift (GHandler sub master) (GWidget sub master) where
+instance MonadLift (GHandler site) (GWidget site) where
     lift = GWidget . fmap (\x -> (x, mempty))
 
-instance MonadLift (ResourceT IO) (GHandler sub master) where
+instance MonadLift (ResourceT IO) (GHandler site) where
     lift = GHandler . const
 
 -- Instances for GHandler
-instance Functor (GHandler sub master) where
+instance Functor (GHandler site) where
     fmap f (GHandler x) = GHandler $ \r -> fmap f (x r)
-instance Applicative (GHandler sub master) where
+instance Applicative (GHandler site) where
     pure = GHandler . const . pure
     GHandler f <*> GHandler x = GHandler $ \r -> f r <*> x r
-instance Monad (GHandler sub master) where
+instance Monad (GHandler site) where
     return = pure
     GHandler x >>= f = GHandler $ \r -> x r >>= \x' -> unGHandler (f x') r
-instance MonadIO (GHandler sub master) where
+instance MonadIO (GHandler site) where
     liftIO = GHandler . const . lift
-instance MonadBase IO (GHandler sub master) where
+instance MonadBase IO (GHandler site) where
     liftBase = GHandler . const . lift
 -- | Note: although we provide a @MonadBaseControl@ instance, @lifted-base@'s
 -- @fork@ function is incompatible with the underlying @ResourceT@ system.
@@ -412,25 +408,25 @@ instance MonadBase IO (GHandler sub master) 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 IO (GHandler sub master) where
+instance MonadBaseControl IO (GHandler site) where
-    data StM (GHandler sub master) a = StH (StM (ResourceT IO) a)
+    data StM (GHandler site) a = StH (StM (ResourceT IO) a)
     liftBaseWith f = GHandler $ \reader ->
         liftBaseWith $ \runInBase ->
             f $ liftM StH . runInBase . (\(GHandler r) -> r reader)
     restoreM (StH base) = GHandler $ const $ restoreM base
 
-instance MonadUnsafeIO (GHandler sub master) where
+instance MonadUnsafeIO (GHandler site) where
     unsafeLiftIO = liftIO
-instance MonadThrow (GHandler sub master) where
+instance MonadThrow (GHandler site) where
     monadThrow = liftIO . throwIO
-instance MonadResource (GHandler sub master) where
+instance MonadResource (GHandler site) where
     liftResourceT = lift . liftResourceT
 
-instance MonadLogger (GHandler sub master) where
+instance MonadLogger (GHandler site) where
     monadLoggerLog a b c d = GHandler $ \hd ->
         liftIO $ rheLog (handlerEnv hd) a b c (toLogStr d)
 
-instance Exception e => Failure e (GHandler sub master) where
+instance Exception e => Failure e (GHandler site) where
     failure = liftIO . throwIO
 
 instance Monoid (UniqueList x) where

yesod-core/Yesod/Core/Widget.hs

@@ -25,8 +25,6 @@ module Yesod.Core.Widget
       -- ** Head of page
     , setTitle
     , setTitleI
-      -- ** Body
-    , addSubWidget
       -- ** CSS
     , addStylesheet
     , addStylesheetAttrs
@@ -70,121 +68,109 @@ import Yesod.Core.Types
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
-addSubWidget :: (Route sub -> Route master) -> sub -> GWidget sub master a -> GWidget sub' master a
+class ToWidget site a where
-addSubWidget toMaster sub (GWidget (GHandler f)) =
+    toWidget :: a -> GWidget site ()
-    GWidget $ GHandler $ f . modHD
-  where
-    modHD hd = hd
-        { handlerEnv = (handlerEnv hd)
-            { rheRoute = Nothing
-            , rheSub = sub
-            , rheToMaster = toMaster
-            }
-        }
 
-class ToWidget sub master a where
+instance render ~ RY site => ToWidget site (render -> Html) where
-    toWidget :: a -> GWidget sub master ()
-
-instance render ~ RY master => ToWidget sub master (render -> Html) where
     toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
-instance render ~ RY master => ToWidget sub master (render -> Css) where
+instance render ~ RY site => ToWidget site (render -> Css) where
     toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . x
-instance render ~ RY master => ToWidget sub master (render -> CssBuilder) where
+instance render ~ RY site => ToWidget site (render -> CssBuilder) where
     toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
-instance render ~ RY master => ToWidget sub master (render -> Javascript) where
+instance render ~ RY site => ToWidget site (render -> Javascript) where
     toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
-instance (sub' ~ sub, master' ~ master) => ToWidget sub' master' (GWidget sub master ()) where
+instance (site' ~ site) => ToWidget site' (GWidget site ()) where
     toWidget = id
-instance ToWidget sub master Html where
+instance ToWidget site Html where
     toWidget = toWidget . const
 
 -- | Allows adding some CSS to the page with a specific media type.
 --
 -- Since 1.2
-class ToWidgetMedia sub master a where
+class ToWidgetMedia site a where
     -- | Add the given content to the page, but only for the given media type.
     --
     -- Since 1.2
     toWidgetMedia :: Text -- ^ media value
                   -> a
-                  -> GWidget sub master ()
+                  -> GWidget site ()
-instance render ~ RY master => ToWidgetMedia sub master (render -> Css) where
+instance render ~ RY site => ToWidgetMedia site (render -> Css) where
     toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . x
-instance render ~ RY master => ToWidgetMedia sub master (render -> CssBuilder) where
+instance render ~ RY site => ToWidgetMedia site (render -> CssBuilder) where
     toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
 
-class ToWidgetBody sub master a where
+class ToWidgetBody site a where
-    toWidgetBody :: a -> GWidget sub master ()
+    toWidgetBody :: a -> GWidget site ()
 
-instance render ~ RY master => ToWidgetBody sub master (render -> Html) where
+instance render ~ RY site => ToWidgetBody site (render -> Html) where
     toWidgetBody = toWidget
-instance render ~ RY master => ToWidgetBody sub master (render -> Javascript) where
+instance render ~ RY site => ToWidgetBody site (render -> Javascript) where
     toWidgetBody j = toWidget $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
-instance ToWidgetBody sub master Html where
+instance ToWidgetBody site Html where
     toWidgetBody = toWidget
 
-class ToWidgetHead sub master a where
+class ToWidgetHead site a where
-    toWidgetHead :: a -> GWidget sub master ()
+    toWidgetHead :: a -> GWidget site ()
 
-instance render ~ RY master => ToWidgetHead sub master (render -> Html) where
+instance render ~ RY site => ToWidgetHead site (render -> Html) where
     toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
-instance render ~ RY master => ToWidgetHead sub master (render -> Css) where
+instance render ~ RY site => ToWidgetHead site (render -> Css) where
     toWidgetHead = toWidget
-instance render ~ RY master => ToWidgetHead sub master (render -> CssBuilder) where
+instance render ~ RY site => ToWidgetHead site (render -> CssBuilder) where
     toWidgetHead = toWidget
-instance render ~ RY master => ToWidgetHead sub master (render -> Javascript) where
+instance render ~ RY site => ToWidgetHead site (render -> Javascript) where
     toWidgetHead j = toWidgetHead $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
-instance ToWidgetHead sub master Html where
+instance ToWidgetHead site Html where
     toWidgetHead = toWidgetHead . const
 
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
-setTitle :: Html -> GWidget sub master ()
+setTitle :: Html -> GWidget site ()
 setTitle x = tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
 
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
-setTitleI :: RenderMessage master msg => msg -> GWidget sub master ()
+setTitleI :: RenderMessage site msg => msg -> GWidget site ()
 setTitleI msg = do
     mr <- lift getMessageRender
     setTitle $ toHtml $ mr msg
 
 -- | Link to the specified local stylesheet.
-addStylesheet :: Route master -> GWidget sub master ()
+addStylesheet :: Route site -> GWidget site ()
 addStylesheet = flip addStylesheetAttrs []
 
 -- | Link to the specified local stylesheet.
-addStylesheetAttrs :: Route master -> [(Text, Text)] -> GWidget sub master ()
+addStylesheetAttrs :: Route site -> [(Text, Text)] -> GWidget site ()
 addStylesheetAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
 
 -- | Link to the specified remote stylesheet.
-addStylesheetRemote :: Text -> GWidget sub master ()
+addStylesheetRemote :: Text -> GWidget site ()
 addStylesheetRemote = flip addStylesheetRemoteAttrs []
 
 -- | Link to the specified remote stylesheet.
-addStylesheetRemoteAttrs :: Text -> [(Text, Text)] -> GWidget sub master ()
+addStylesheetRemoteAttrs :: Text -> [(Text, Text)] -> GWidget site ()
 addStylesheetRemoteAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
 
-addStylesheetEither :: Either (Route master) Text -> GWidget sub master ()
+addStylesheetEither :: Either (Route site) Text -> GWidget site ()
 addStylesheetEither = either addStylesheet addStylesheetRemote
 
-addScriptEither :: Either (Route master) Text -> GWidget sub master ()
+addScriptEither :: Either (Route site) Text -> GWidget site ()
 addScriptEither = either addScript addScriptRemote
 
 -- | Link to the specified local script.
-addScript :: Route master -> GWidget sub master ()
+addScript :: Route site -> GWidget site ()
 addScript = flip addScriptAttrs []
 
 -- | Link to the specified local script.
-addScriptAttrs :: Route master -> [(Text, Text)] -> GWidget sub master ()
+addScriptAttrs :: Route site -> [(Text, Text)] -> GWidget site ()
 addScriptAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
 
 -- | Link to the specified remote script.
-addScriptRemote :: Text -> GWidget sub master ()
+addScriptRemote :: Text -> GWidget site ()
 addScriptRemote = flip addScriptRemoteAttrs []
 
 -- | Link to the specified remote script.
-addScriptRemoteAttrs :: Text -> [(Text, Text)] -> GWidget sub master ()
+addScriptRemoteAttrs :: Text -> [(Text, Text)] -> GWidget site ()
 addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
 
 whamlet :: QuasiQuoter
@@ -214,20 +200,20 @@ rules = do
     return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-ihamletToRepHtml :: RenderMessage master message
+ihamletToRepHtml :: RenderMessage site message
-                 => HtmlUrlI18n message (Route master)
+                 => HtmlUrlI18n message (Route site)
-                 -> GHandler sub master Html
+                 -> GHandler site Html
 ihamletToRepHtml ih = do
     urender <- getUrlRenderParams
     mrender <- getMessageRender
     return $ ih (toHtml . mrender) urender
 
-tell :: GWData (Route master) -> GWidget sub master ()
+tell :: GWData (Route site) -> GWidget site ()
 tell w = GWidget $ return ((), w)
 
 -- | Type-restricted version of @lift@. Used internally to create better error
 -- messages.
-liftW :: GHandler sub master a -> GWidget sub master a
+liftW :: GHandler site a -> GWidget site a
 liftW = lift
 
 toUnique :: x -> UniqueList x

yesod-core/test/YesodCoreTest/JsLoader.hs

@@ -30,5 +30,5 @@ specs = describe "Test.JsLoader" $ do
       res <- request defaultRequest
       assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><script src=\"load.js\"></script></body></html>" res
 
-runner :: (YesodDispatch master master, Yesod master) => master -> Session () -> IO ()
+runner :: YesodDispatch master => master -> Session () -> IO ()
 runner app f = toWaiApp app >>= runSession f

yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs

@@ -15,16 +15,16 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 getSubsite :: a -> Subsite
 getSubsite = const Subsite
 
-instance YesodSubDispatch Subsite (GHandler master master) where
+instance YesodSubDispatch Subsite (GHandler master) where
     yesodSubDispatch = $(mkYesodSubDispatch resourcesSubsite)
 
 getBarR :: Monad m => m T.Text
 getBarR = return $ T.pack "BarR"
 
-getBazR :: Yesod master => HandlerT Subsite (GHandler master master) RepHtml
+getBazR :: Yesod master => HandlerT Subsite (GHandler master) RepHtml
 getBazR = lift $ defaultLayout [whamlet|Used Default Layout|]
 
-getBinR :: MonadHandlerBase m => HandlerT Subsite m RepHtml
+getBinR :: MonadHandler m => HandlerT Subsite m RepHtml
 getBinR = defaultLayoutT
     [whamlet|
         <p>Used defaultLayoutT

yesod-core/test/YesodCoreTest/YesodTest.hs

@@ -14,5 +14,5 @@ import Network.Wai.Test
 import Network.Wai
 import Test.Hspec
 
-yesod :: (YesodDispatch y y, Yesod y) => y -> Session a -> IO a
+yesod :: YesodDispatch y => y -> Session a -> IO a
 yesod app f = toWaiApp app >>= runSession f