Everything compiles

yesod-auth/Yesod/Auth.hs

@@ -27,9 +27,10 @@ module Yesod.Auth
     , AuthException (..)
     ) where
 
-import Control.Monad                 (when)  
+import Control.Monad                 (when)
 import Control.Monad.Trans.Maybe
 
+import Yesod.Auth.Routes
 import Data.Aeson
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
@@ -51,17 +52,17 @@ import Yesod.Form (FormMessage)
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
 
-data Auth = Auth
-
 type AuthRoute = Route Auth
 
+type AuthHandler master a = YesodAuth master => HandlerT Auth (GHandler master) a
+
 type Method = Text
 type Piece = Text
 
 data AuthPlugin master = AuthPlugin
     { apName :: Text
-    , apDispatch :: Method -> [Piece] -> GHandler Auth master ()
-    , apLogin :: forall sub. (Route Auth -> Route master) -> GWidget sub master ()
+    , apDispatch :: Method -> [Piece] -> AuthHandler master ()
+    , apLogin :: (Route Auth -> Text) -> GWidget master ()
     }
 
 getAuth :: a -> Auth
@@ -86,18 +87,19 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     logoutDest :: master -> Route master
 
     -- | Determine the ID associated with the set of credentials.
-    getAuthId :: Creds master -> GHandler sub master (Maybe (AuthId master))
+    getAuthId :: Creds master -> GHandler master (Maybe (AuthId master))
 
     -- | Which authentication backends to use.
     authPlugins :: master -> [AuthPlugin master]
 
     -- | What to show on the login page.
-    loginHandler :: GHandler Auth master RepHtml
-    loginHandler = defaultLayout $ do
-        setTitleI Msg.LoginTitle
-        tm <- lift getRouteToMaster
-        master <- lift getYesod
-        mapM_ (flip apLogin tm) (authPlugins master)
+    loginHandler :: AuthHandler master RepHtml
+    loginHandler = do
+        render <- getUrlRender
+        lift $ defaultLayout $ do
+            setTitleI Msg.LoginTitle
+            master <- lift getYesod
+            mapM_ (flip apLogin render) (authPlugins master)
 
     -- | Used for i18n of messages provided by this package.
     renderAuthMessage :: master
@@ -118,11 +120,11 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
 
     -- | Called on a successful login. By default, calls
     -- @setMessageI NowLoggedIn@.
-    onLogin :: GHandler sub master ()
+    onLogin :: GHandler master ()
     onLogin = setMessageI Msg.NowLoggedIn
 
     -- | Called on logout. By default, does nothing
-    onLogout :: GHandler sub master ()
+    onLogout :: GHandler master ()
     onLogout = return ()
 
     -- | Retrieves user credentials, if user is authenticated.
@@ -134,7 +136,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     -- other than a browser.
     --
     -- Since 1.1.2
-    maybeAuthId :: GHandler sub master (Maybe (AuthId master))
+    maybeAuthId :: GHandler master (Maybe (AuthId master))
     maybeAuthId = defaultMaybeAuthId
 
 credsKey :: Text
@@ -144,29 +146,15 @@ credsKey = "_ID"
 --
 -- Since 1.1.2
 defaultMaybeAuthId :: YesodAuth master
-                   => GHandler sub master (Maybe (AuthId master))
+                   => GHandler master (Maybe (AuthId master))
 defaultMaybeAuthId = do
     ms <- lookupSession credsKey
     case ms of
         Nothing -> return Nothing
         Just s -> return $ fromPathPiece s
 
-mkYesodSub "Auth"
-    [ ClassP ''YesodAuth [VarT $ mkName "master"]
-    ]
-#define STRINGS *Texts
-    [parseRoutes|
-/check                 CheckR      GET
-/login                 LoginR      GET
-/logout                LogoutR     GET POST
-/page/#Text/STRINGS PluginR
-|]
-
-setCreds :: YesodAuth master
-         => Bool
-         -> Creds master
-         -> GHandler sub master ()
-setCreds doRedirects creds = do
+setCreds :: Bool -> Creds master -> AuthHandler master ()
+setCreds doRedirects creds = lift $ do
     y    <- getYesod
     maid <- getAuthId creds
     case maid of
@@ -196,8 +184,8 @@ setCreds doRedirects creds = do
                     provideRep $ return $ object ["message" .= ("Login Successful" :: Text)]
                 sendResponse res
 
-getCheckR :: YesodAuth master => GHandler Auth master TypedContent
-getCheckR = do
+getCheckR :: AuthHandler master TypedContent
+getCheckR = lift $ do
     creds <- maybeAuthId
     defaultLayoutJson (do
         setTitle "Authentication Status"
@@ -217,29 +205,27 @@ $nothing
             [ (T.pack "logged_in", Bool $ maybe False (const True) creds)
             ]
 
-setUltDestReferer' :: YesodAuth master => GHandler sub master ()
-setUltDestReferer' = do
+setUltDestReferer' :: AuthHandler master ()
+setUltDestReferer' = lift $ do
     master <- getYesod
     when (redirectToReferer master) setUltDestReferer
 
-getLoginR :: YesodAuth master => GHandler Auth master RepHtml
+getLoginR :: AuthHandler master RepHtml
 getLoginR = setUltDestReferer' >> loginHandler
 
-getLogoutR :: YesodAuth master => GHandler Auth master ()
-getLogoutR = do
-    tm <- getRouteToMaster
-    setUltDestReferer' >> redirectToPost (tm LogoutR)
+getLogoutR :: AuthHandler master ()
+getLogoutR = setUltDestReferer' >> redirectToPost LogoutR
 
-postLogoutR :: YesodAuth master => GHandler Auth master ()
-postLogoutR = do
+postLogoutR :: AuthHandler master ()
+postLogoutR = lift $ do
     y <- getYesod
     deleteSession credsKey
     onLogout
     redirectUltDest $ logoutDest y
 
-handlePluginR :: YesodAuth master => Text -> [Text] -> GHandler Auth master ()
+handlePluginR :: Text -> [Text] -> AuthHandler master ()
 handlePluginR plugin pieces = do
-    master <- getYesod
+    master <- lift getYesod
     env <- waiRequest
     let method = decodeUtf8With lenientDecode $ W.requestMethod env
     case filter (\x -> apName x == plugin) (authPlugins master) of
@@ -247,14 +233,14 @@ handlePluginR plugin pieces = do
         ap:_ -> apDispatch ap method pieces
 
 maybeAuth :: ( YesodAuth master
-             , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val
+             , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend val
              , b ~ YesodPersistBackend master
              , Key val ~ AuthId master
-             , PersistStore (b (GHandler sub master))
+             , PersistStore (b (GHandler master))
              , PersistEntity val
              , YesodPersist master
              , Typeable val
-             ) => GHandler sub master (Maybe (Entity val))
+             ) => GHandler master (Maybe (Entity val))
 maybeAuth = runMaybeT $ do
     aid <- MaybeT $ maybeAuthId
     a   <- MaybeT
@@ -268,21 +254,21 @@ maybeAuth = runMaybeT $ do
 newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val }
     deriving Typeable
 
-requireAuthId :: YesodAuth master => GHandler sub master (AuthId master)
+requireAuthId :: YesodAuth master => GHandler master (AuthId master)
 requireAuthId = maybeAuthId >>= maybe redirectLogin return
 
 requireAuth :: ( YesodAuth master
                , b ~ YesodPersistBackend master
-               , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val
+               , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend val
                , Key val ~ AuthId master
-               , PersistStore (b (GHandler sub master))
+               , PersistStore (b (GHandler master))
                , PersistEntity val
                , YesodPersist master
                , Typeable val
-               ) => GHandler sub master (Entity val)
+               ) => GHandler master (Entity val)
 requireAuth = maybeAuth >>= maybe redirectLogin return
 
-redirectLogin :: Yesod master => GHandler sub master a
+redirectLogin :: Yesod master => GHandler master a
 redirectLogin = do
     y <- getYesod
     setUltDestCurrent
@@ -297,3 +283,6 @@ data AuthException = InvalidBrowserIDAssertion
                    | InvalidFacebookResponse
     deriving (Show, Typeable)
 instance Exception AuthException
+
+instance YesodAuth master => YesodSubDispatch Auth (GHandler master) where
+    yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)

yesod-auth/Yesod/Auth/BrowserId.hs

@@ -49,14 +49,13 @@ helper maudience = AuthPlugin
     , apDispatch = \m ps ->
         case (m, ps) of
             ("GET", [assertion]) -> do
-                master <- getYesod
+                master <- lift getYesod
                 audience <-
                     case maudience of
                         Just a -> return a
                         Nothing -> do
-                            tm <- getRouteToMaster
                             r <- getUrlRender
-                            return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
+                            return $ T.takeWhile (/= '/') $ stripScheme $ r LoginR
                 memail <- lift $ checkAssertion audience assertion (authHttpManager master)
                 case memail of
                     Nothing -> liftIO $ throwIO InvalidBrowserIDAssertion
@@ -83,7 +82,7 @@ helper maudience = AuthPlugin
 $newline never
 <p>
     <a href="javascript:#{onclick}()">
-        <img src=@{toMaster loginIcon}>
+        <img src=#{toMaster loginIcon}>
 |]
     }
   where
@@ -92,18 +91,18 @@ $newline never
 
 -- | Generates a function to handle on-click events, and returns that function
 -- name.
-createOnClick :: (Route Auth -> Route master) -> GWidget sub master Text
+createOnClick :: (Route Auth -> Text) -> GWidget master Text
 createOnClick toMaster = do
     addScriptRemote browserIdJs
-    onclick <- lift newIdent
-    render <- lift getUrlRender
-    let login = toJSON $ getPath $ render (toMaster LoginR)
+    onclick <- newIdent
+    render <- getUrlRender
+    let login = toJSON $ getPath $ toMaster LoginR
     toWidget [julius|
         function #{rawJS onclick}() {
             navigator.id.watch({
                 onlogin: function (assertion) {
                     if (assertion) {
-                        document.location = "@{toMaster complete}/" + assertion;
+                        document.location = #{toJSON $ toMaster complete} + "/" + assertion;
                     }
                 },
                 onlogout: function () {}

yesod-auth/Yesod/Auth/Dummy.hs

@@ -9,23 +9,22 @@ module Yesod.Auth.Dummy
 
 import Yesod.Auth
 import Yesod.Form (runInputPost, textField, ireq)
-import Yesod.Handler (notFound)
 import Text.Hamlet (hamlet)
-import Yesod.Widget (toWidget)
+import Yesod.Core
 
 authDummy :: YesodAuth m => AuthPlugin m
 authDummy =
     AuthPlugin "dummy" dispatch login
   where
     dispatch "POST" [] = do
-        ident <- runInputPost $ ireq textField "ident"
+        ident <- lift $ runInputPost $ ireq textField "ident"
         setCreds True $ Creds "dummy" ident []
     dispatch _ _ = notFound
     url = PluginR "dummy" []
     login authToMaster =
         toWidget [hamlet|
 $newline never
-<form method="post" action="@{authToMaster url}">
+<form method="post" action="#{authToMaster url}">
     Your new identifier is: #
     <input type="text" name="ident">
     <input type="submit" value="Dummy Login">

yesod-auth/Yesod/Auth/Email.hs

@@ -17,6 +17,7 @@ module Yesod.Auth.Email
 import Network.Mail.Mime (randomString)
 import Yesod.Auth
 import System.Random
+import Text.Blaze.Html (toHtml)
 import Control.Monad (when)
 import Control.Applicative ((<$>), (<*>))
 import Data.Digest.Pure.MD5
@@ -28,9 +29,7 @@ import qualified Crypto.PasswordStore as PS
 import qualified Data.Text.Encoding as DTE
 
 import Yesod.Form
-import Yesod.Handler
-import Yesod.Content
-import Yesod.Core (PathPiece, fromPathPiece, whamlet, defaultLayout, setTitleI, toPathPiece)
+import Yesod.Core
 import Control.Monad.IO.Class (liftIO)
 import qualified Yesod.Auth.Message as Msg
 
@@ -59,15 +58,15 @@ data EmailCreds m = EmailCreds
 class (YesodAuth m, PathPiece (AuthEmailId m)) => YesodAuthEmail m where
     type AuthEmailId m
 
-    addUnverified :: Email -> VerKey -> GHandler Auth m (AuthEmailId m)
-    sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler Auth m ()
-    getVerifyKey :: AuthEmailId m -> GHandler Auth m (Maybe VerKey)
-    setVerifyKey :: AuthEmailId m -> VerKey -> GHandler Auth m ()
-    verifyAccount :: AuthEmailId m -> GHandler Auth m (Maybe (AuthId m))
-    getPassword :: AuthId m -> GHandler Auth m (Maybe SaltedPass)
-    setPassword :: AuthId m -> SaltedPass -> GHandler Auth m ()
-    getEmailCreds :: Email -> GHandler Auth m (Maybe (EmailCreds m))
-    getEmail :: AuthEmailId m -> GHandler Auth m (Maybe Email)
+    addUnverified :: Email -> VerKey -> GHandler m (AuthEmailId m)
+    sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler m ()
+    getVerifyKey :: AuthEmailId m -> GHandler m (Maybe VerKey)
+    setVerifyKey :: AuthEmailId m -> VerKey -> GHandler m ()
+    verifyAccount :: AuthEmailId m -> GHandler m (Maybe (AuthId m))
+    getPassword :: AuthId m -> GHandler m (Maybe SaltedPass)
+    setPassword :: AuthId m -> SaltedPass -> GHandler m ()
+    getEmailCreds :: Email -> GHandler m (Maybe (EmailCreds m))
+    getEmail :: AuthEmailId m -> GHandler m (Maybe Email)
 
     -- | Generate a random alphanumeric string.
     randomKey :: m -> IO Text
@@ -80,7 +79,7 @@ authEmail =
     AuthPlugin "email" dispatch $ \tm ->
         [whamlet|
 $newline never
-<form method="post" action="@{tm loginR}">
+<form method="post" action="#{tm loginR}">
     <table>
         <tr>
             <th>_{Msg.Email}
@@ -93,7 +92,7 @@ $newline never
         <tr>
             <td colspan="2">
                 <input type="submit" value=_{Msg.LoginViaEmail}>
-                <a href="@{tm registerR}">I don't have an account
+                <a href="#{tm registerR}">I don't have an account
 |]
   where
     dispatch "GET" ["register"] = getRegisterR >>= sendResponse
@@ -107,81 +106,75 @@ $newline never
     dispatch "POST" ["set-password"] = postPasswordR >>= sendResponse
     dispatch _ _ = notFound
 
-getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
+getRegisterR :: YesodAuthEmail master => HandlerT Auth (GHandler master) RepHtml
 getRegisterR = do
-    toMaster <- getRouteToMaster
     email <- newIdent
-    defaultLayout $ do
-        setTitleI Msg.RegisterLong
+    mrender <- getMessageRender
+    defaultLayoutT $ do
+        setTitle $ toHtml $ mrender Msg.RegisterLong
         [whamlet|
-$newline never
-<p>_{Msg.EnterEmail}
-<form method="post" action="@{toMaster registerR}">
-    <label for=#{email}>_{Msg.Email}
-    <input ##{email} type="email" name="email" width="150">
-    <input type="submit" value=_{Msg.Register}>
-|]
+            <p>#{mrender Msg.EnterEmail}
+            <form method="post" action="@{registerR}">
+                <label for=#{email}>#{mrender Msg.Email}
+                <input ##{email} type="email" name="email" width="150">
+                <input type="submit" value=#{mrender Msg.Register}>
+        |]
 
-postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
+postRegisterR :: YesodAuthEmail master => HandlerT Auth (GHandler master) RepHtml
 postRegisterR = do
-    y <- getYesod
-    email <- runInputPost $ ireq emailField "email"
-    mecreds <- getEmailCreds email
+    y <- lift getYesod
+    email <- lift $ runInputPost $ ireq emailField "email"
+    mecreds <- lift $ getEmailCreds email
     (lid, verKey) <-
         case mecreds of
             Just (EmailCreds lid _ _ (Just key)) -> return (lid, key)
             Just (EmailCreds lid _ _ Nothing) -> do
                 key <- liftIO $ randomKey y
-                setVerifyKey lid key
+                lift $ setVerifyKey lid key
                 return (lid, key)
             Nothing -> do
                 key <- liftIO $ randomKey y
-                lid <- addUnverified email key
+                lid <- lift $ addUnverified email key
                 return (lid, key)
     render <- getUrlRender
-    tm <- getRouteToMaster
-    let verUrl = render $ tm $ verify (toPathPiece lid) verKey
-    sendVerifyEmail email verKey verUrl
-    defaultLayout $ do
+    let verUrl = render $ verify (toPathPiece lid) verKey
+    lift $ sendVerifyEmail email verKey verUrl
+    lift $ defaultLayout $ do
         setTitleI Msg.ConfirmationEmailSentTitle
-        [whamlet|
-$newline never
-<p>_{Msg.ConfirmationEmailSent email}
-|]
+        [whamlet|<p>_{Msg.ConfirmationEmailSent email}|]
 
 getVerifyR :: YesodAuthEmail m
-           => AuthEmailId m -> Text -> GHandler Auth m RepHtml
+           => AuthEmailId m
+           -> Text
+           -> HandlerT Auth (GHandler m) RepHtml
 getVerifyR lid key = do
-    realKey <- getVerifyKey lid
-    memail <- getEmail lid
+    realKey <- lift $ getVerifyKey lid
+    memail <- lift $ getEmail lid
     case (realKey == Just key, memail) of
         (True, Just email) -> do
-            muid <- verifyAccount lid
+            muid <- lift $ verifyAccount lid
             case muid of
                 Nothing -> return ()
                 Just _uid -> do
                     setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid?
-                    toMaster <- getRouteToMaster
-                    setMessageI Msg.AddressVerified
-                    redirect $ toMaster setpassR
+                    mrender <- lift getMessageRender
+                    setMessage $ toHtml $ mrender Msg.AddressVerified
+                    redirect setpassR
         _ -> return ()
-    defaultLayout $ do
+    lift $ defaultLayout $ do
         setTitleI Msg.InvalidKey
-        [whamlet|
-$newline never
-<p>_{Msg.InvalidKey}
-|]
+        [whamlet|<p>_{Msg.InvalidKey}|]
 
-postLoginR :: YesodAuthEmail master => GHandler Auth master ()
+postLoginR :: YesodAuthEmail master => HandlerT Auth (GHandler master) ()
 postLoginR = do
-    (email, pass) <- runInputPost $ (,)
+    (email, pass) <- lift $ runInputPost $ (,)
         <$> ireq emailField "email"
         <*> ireq textField "password"
-    mecreds <- getEmailCreds email
+    mecreds <- lift $ getEmailCreds email
     maid <-
         case (mecreds >>= emailCredsAuthId, fmap emailCredsStatus mecreds) of
             (Just aid, Just True) -> do
-                mrealpass <- getPassword aid
+                mrealpass <- lift $ getPassword aid
                 case mrealpass of
                     Nothing -> return Nothing
                     Just realpass -> return $
@@ -193,63 +186,63 @@ postLoginR = do
         Just _aid ->
             setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid?
         Nothing -> do
-            setMessageI Msg.InvalidEmailPass
-            toMaster <- getRouteToMaster
-            redirect $ toMaster LoginR
+            mrender <- lift getMessageRender
+            setMessage $ toHtml $ mrender Msg.InvalidEmailPass
+            redirect LoginR
 
-getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml
+getPasswordR :: YesodAuthEmail master => HandlerT Auth (GHandler master) RepHtml
 getPasswordR = do
-    toMaster <- getRouteToMaster
-    maid <- maybeAuthId
+    maid <- lift maybeAuthId
     pass1 <- newIdent
     pass2 <- newIdent
+    mrender <- lift getMessageRender
     case maid of
         Just _ -> return ()
         Nothing -> do
-            setMessageI Msg.BadSetPass
-            redirect $ toMaster LoginR
-    defaultLayout $ do
-        setTitleI Msg.SetPassTitle
+            setMessage $ toHtml $ mrender Msg.BadSetPass
+            redirect LoginR
+    defaultLayoutT $ do
+        setTitle $ toHtml $ mrender Msg.SetPassTitle -- FIXME make setTitleI more intelligent
         [whamlet|
 $newline never
-<h3>_{Msg.SetPass}
-<form method="post" action="@{toMaster setpassR}">
+<h3>#{mrender Msg.SetPass}
+<form method="post" action="@{setpassR}">
     <table>
         <tr>
             <th>
-                <label for=#{pass1}>_{Msg.NewPass}
+                <label for=#{pass1}>#{mrender Msg.NewPass}
             <td>
                 <input ##{pass1} type="password" name="new">
         <tr>
             <th>
-                <label for=#{pass2}>_{Msg.ConfirmPass}
+                <label for=#{pass2}>#{mrender Msg.ConfirmPass}
             <td>
                 <input ##{pass2} type="password" name="confirm">
         <tr>
             <td colspan="2">
-                <input type="submit" value="_{Msg.SetPassTitle}">
+                <input type="submit" value=#{mrender Msg.SetPassTitle}>
 |]
 
-postPasswordR :: YesodAuthEmail master => GHandler Auth master ()
+postPasswordR :: YesodAuthEmail master => HandlerT Auth (GHandler master) ()
 postPasswordR = do
-    (new, confirm) <- runInputPost $ (,)
+    (new, confirm) <- lift $ runInputPost $ (,)
         <$> ireq textField "new"
         <*> ireq textField "confirm"
-    toMaster <- getRouteToMaster
-    y <- getYesod
     when (new /= confirm) $ do
-        setMessageI Msg.PassMismatch
-        redirect $ toMaster setpassR
-    maid <- maybeAuthId
+        lift $ setMessageI Msg.PassMismatch
+        redirect setpassR
+    maid <- lift maybeAuthId
     aid <- case maid of
             Nothing -> do
-                setMessageI Msg.BadSetPass
-                redirect $ toMaster LoginR
+                lift $ setMessageI Msg.BadSetPass
+                redirect LoginR
             Just aid -> return aid
     salted <- liftIO $ saltPass new
-    setPassword aid salted
-    setMessageI Msg.PassUpdated
-    redirect $ loginDest y
+    lift $ do
+        y <- getYesod
+        setPassword aid salted
+        setMessageI Msg.PassUpdated
+        redirect $ loginDest y
 
 saltLength :: Int
 saltLength = 5

yesod-auth/Yesod/Auth/GoogleEmail.hs

@@ -40,15 +40,11 @@ authGoogleEmail =
   where
     complete = PluginR pid ["complete"]
     login tm =
-        [whamlet|
-$newline never
-<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}
-|]
+        [whamlet|<a href=#{tm forwardUrl}>_{Msg.LoginGoogle}|]
     dispatch "GET" ["forward"] = do
         render <- getUrlRender
-        toMaster <- getRouteToMaster
-        let complete' = render $ toMaster complete
-        master <- getYesod
+        let complete' = render complete
+        master <- lift getYesod
         eres <- lift $ try $ OpenId.getForwardUrl googleIdent complete' Nothing
             [ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
             , ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
@@ -60,7 +56,7 @@ $newline never
         either
           (\err -> do
                 setMessage $ toHtml $ show (err :: SomeException)
-                redirect $ toMaster LoginR
+                redirect LoginR
                 )
           redirect
           eres
@@ -74,14 +70,13 @@ $newline never
         completeHelper posts
     dispatch _ _ = notFound
 
-completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()
+completeHelper :: YesodAuth m => [(Text, Text)] -> HandlerT Auth (GHandler m) ()
 completeHelper gets' = do
-        master <- getYesod
+        master <- lift getYesod
         eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
-        toMaster <- getRouteToMaster
         let onFailure err = do
             setMessage $ toHtml $ show (err :: SomeException)
-            redirect $ toMaster LoginR
+            redirect LoginR
         let onSuccess oir = do
                 let OpenId.Identifier ident = OpenId.oirOpLocal oir
                 memail <- lookupGetParam "openid.ext1.value.email"
@@ -89,8 +84,8 @@ completeHelper gets' = do
                     (Just email, True) -> setCreds True $ Creds pid email []
                     (_, False) -> do
                         setMessage "Only Google login is supported"
-                        redirect $ toMaster LoginR
+                        redirect LoginR
                     (Nothing, _) -> do
                         setMessage "No email address provided"
-                        redirect $ toMaster LoginR
+                        redirect LoginR
         either onFailure onSuccess eres

yesod-auth/Yesod/Auth/HashDB.hs

@@ -73,10 +73,9 @@ module Yesod.Auth.HashDB
     ) where
 
 import Yesod.Persist
-import Yesod.Handler
 import Yesod.Form
 import Yesod.Auth
-import Yesod.Widget (toWidget)
+import Yesod.Core
 import Text.Hamlet (hamlet)
 
 import Control.Applicative         ((<$>), (<*>))
@@ -135,14 +134,14 @@ setPassword pwd u = do salt <- randomSalt
 --   the database values.
 validateUser :: ( YesodPersist yesod
                 , b ~ YesodPersistBackend yesod
-                , PersistMonadBackend (b (GHandler sub yesod)) ~ PersistEntityBackend user
-                , PersistUnique (b (GHandler sub yesod))
+                , PersistMonadBackend (b (GHandler yesod)) ~ PersistEntityBackend user
+                , PersistUnique (b (GHandler yesod))
                 , PersistEntity user
                 , HashDBUser    user
                 ) => 
                 Unique user     -- ^ User unique identifier
              -> Text            -- ^ Password in plaint-text
-             -> GHandler sub yesod Bool
+             -> GHandler yesod Bool
 validateUser userID passwd = do
   -- Checks that hash and password match
   let validate u = do hash <- userPasswordHash u
@@ -162,23 +161,22 @@ login = PluginR "hashdb" ["login"]
 postLoginR :: ( YesodAuth y, YesodPersist y
               , HashDBUser user, PersistEntity user
               , b ~ YesodPersistBackend y
-              , PersistMonadBackend (b (GHandler Auth y)) ~ PersistEntityBackend user
-              , PersistUnique (b (GHandler Auth y))
+              , PersistMonadBackend (b (GHandler y)) ~ PersistEntityBackend user
+              , PersistUnique (b (GHandler y))
               )
            => (Text -> Maybe (Unique user))
-           -> GHandler Auth y ()
+           -> HandlerT Auth (GHandler y) ()
 postLoginR uniq = do
-    (mu,mp) <- runInputPost $ (,)
+    (mu,mp) <- lift $ runInputPost $ (,)
         <$> iopt textField "username"
         <*> iopt textField "password"
 
-    isValid <- fromMaybe (return False) 
+    isValid <- lift $ fromMaybe (return False) 
                  (validateUser <$> (uniq =<< mu) <*> mp)
     if isValid 
        then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
        else do setMessage "Invalid username/password"
-               toMaster <- getRouteToMaster
-               redirect $ toMaster LoginR
+               redirect LoginR
 
 
 -- | A drop in for the getAuthId method of your YesodAuth instance which
@@ -187,13 +185,13 @@ getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
                    , HashDBUser user, PersistEntity user
                    , Key user ~ AuthId master
                    , b ~ YesodPersistBackend master
-                   , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend user
-                   , PersistUnique (b (GHandler sub master))
+                   , PersistMonadBackend (b (GHandler master)) ~ PersistEntityBackend user
+                   , PersistUnique (b (GHandler master))
                    )
                 => (AuthRoute -> Route master)   -- ^ your site's Auth Route
                 -> (Text -> Maybe (Unique user)) -- ^ gets user ID
                 -> Creds master                  -- ^ the creds argument
-                -> GHandler sub master (Maybe (AuthId master))
+                -> GHandler master (Maybe (AuthId master))
 getAuthIdHashDB authR uniq creds = do
     muid <- maybeAuthId
     case muid of
@@ -216,8 +214,8 @@ authHashDB :: ( YesodAuth m, YesodPersist m
               , HashDBUser user
               , PersistEntity user
               , b ~ YesodPersistBackend m
-              , PersistMonadBackend (b (GHandler Auth m)) ~ PersistEntityBackend user
-              , PersistUnique (b (GHandler Auth m)))
+              , PersistMonadBackend (b (GHandler m)) ~ PersistEntityBackend user
+              , PersistUnique (b (GHandler m)))
            => (Text -> Maybe (Unique user)) -> AuthPlugin m
 authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
 $newline never
@@ -225,7 +223,7 @@ $newline never
         <h1>Login
 
     <div id="login">
-        <form method="post" action="@{tm login}">
+        <form method="post" action="#{tm login}">
             <table>
                 <tr>
                     <th>Username:

yesod-auth/Yesod/Auth/OpenId.hs

@@ -48,35 +48,33 @@ authOpenId idType extensionFields =
 |] $ x `asTypeOf` y)
         [whamlet|
 $newline never
-<form method="get" action="@{tm forwardUrl}">
+<form method="get" action="#{tm forwardUrl}">
     <input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id">
     <button .openid-google>_{Msg.LoginGoogle}
-<form method="get" action="@{tm forwardUrl}">
+<form method="get" action="#{tm forwardUrl}">
     <input type="hidden" name="openid_identifier" value="http://me.yahoo.com">
     <button .openid-yahoo>_{Msg.LoginYahoo}
-<form method="get" action="@{tm forwardUrl}">
+<form method="get" action="#{tm forwardUrl}">
     <label for="#{ident}">OpenID: #
     <input id="#{ident}" type="text" name="#{name}" value="http://">
     <input type="submit" value="_{Msg.LoginOpenID}">
 |]
     dispatch "GET" ["forward"] = do
-        roid <- runInputGet $ iopt textField name
+        roid <- lift $ runInputGet $ iopt textField name
         case roid of
             Just oid -> do
                 render <- getUrlRender
-                toMaster <- getRouteToMaster
-                let complete' = render $ toMaster complete
-                master <- getYesod
+                let complete' = render complete
+                master <- lift getYesod
                 eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing extensionFields (authHttpManager master)
                 case eres of
                     Left err -> do
                         setMessage $ toHtml $ show (err :: SomeException)
-                        redirect $ toMaster LoginR
+                        redirect LoginR
                     Right x -> redirect x
             Nothing -> do
-                toMaster <- getRouteToMaster
                 setMessageI Msg.NoOpenID
-                redirect $ toMaster LoginR
+                redirect LoginR
     dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
     dispatch "GET" ["complete"] = do
         rr <- getRequest
@@ -87,14 +85,13 @@ $newline never
         completeHelper idType posts
     dispatch _ _ = notFound
 
-completeHelper :: YesodAuth m => IdentifierType -> [(Text, Text)] -> GHandler Auth m ()
+completeHelper :: YesodAuth master => IdentifierType -> [(Text, Text)] -> HandlerT Auth (GHandler master) ()
 completeHelper idType gets' = do
-        master <- getYesod
-        eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
-        toMaster <- getRouteToMaster
+        master <- lift getYesod
+        eres <- try $ OpenId.authenticateClaimed gets' (authHttpManager master)
         let onFailure err = do
             setMessage $ toHtml $ show (err :: SomeException)
-            redirect $ toMaster LoginR
+            redirect LoginR
         let onSuccess oir = do
                 let claimed =
                         case OpenId.oirClaimed oir of

yesod-auth/Yesod/Auth/Routes.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Yesod.Auth.Routes where
+
+import Yesod.Core
+import Data.Text (Text)
+
+data Auth = Auth
+
+mkYesodSubData "Auth" [parseRoutes|
+/check                 CheckR      GET
+/login                 LoginR      GET
+/logout                LogoutR     GET POST
+/page/#Text/*Texts PluginR
+|]

yesod-auth/Yesod/Auth/Rpxnow.hs

@@ -12,7 +12,7 @@ import Control.Monad (mplus)
 
 import Yesod.Core
 import Text.Hamlet (hamlet)
-import Data.Text (pack, unpack)
+import Data.Text (pack, unpack, Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Control.Arrow ((***))
@@ -26,13 +26,12 @@ authRpxnow app apiKey =
     AuthPlugin "rpxnow" dispatch login
   where
     login ::
-        forall sub master.
-        ToWidget sub master (GWidget sub master ())
-        => (Route Auth -> Route master) -> GWidget sub master ()
+        forall master.
+        ToWidget master (GWidget master ())
+        => (Route Auth -> Text) -> GWidget master ()
     login tm = do
-        render <- lift getUrlRender
         let queryString = decodeUtf8With lenientDecode
-                        $ renderQuery True [("token_url", Just $ encodeUtf8 $ render $ tm $ PluginR "rpxnow" [])]
+                        $ renderQuery True [("token_url", Just $ encodeUtf8 $ tm $ PluginR "rpxnow" [])]
         toWidget [hamlet|
 $newline never
 <iframe src="http://#{app}.rpxnow.com/openid/embed#{queryString}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
@@ -43,7 +42,7 @@ $newline never
         token <- case token1 ++ token2 of
                         [] -> invalidArgs ["token: Value not supplied"]
                         x:_ -> return $ unpack x
-        master <- getYesod
+        master <- lift getYesod
         Rpxnow.Identifier ident extra <- lift $ Rpxnow.authenticate apiKey token (authHttpManager master)
         let creds =
                 Creds "rpxnow" ident

yesod-auth/yesod-auth.cabal

@@ -54,6 +54,7 @@ library
                      Yesod.Auth.HashDB
                      Yesod.Auth.Message
                      Yesod.Auth.GoogleEmail
+    other-modules:   Yesod.Auth.Routes
     ghc-options:     -Wall
 
 source-repository head

yesod-core/Yesod/Core.hs

@@ -50,6 +50,9 @@ module Yesod.Core
       -- * Subsites
     , defaultLayoutT
     , MonadHandler (..)
+    , HandlerReader (..)
+    , HandlerState (..)
+    , HandlerError (..)
       -- * Misc
     , yesodVersion
     , yesodRender
@@ -121,7 +124,7 @@ defaultLayoutT :: ( HandlerSite m ~ sub
 defaultLayoutT (GWidget (GHandler f)) = do
     hd <- askHandlerData
     ((), gwdata) <- liftResourceT $ f hd
-    liftHandler $ defaultLayout $ GWidget $ return ((), renderGWData (rheRender $ handlerEnv hd) gwdata)
+    liftHandlerMaster $ defaultLayout $ GWidget $ return ((), renderGWData (rheRender $ handlerEnv hd) gwdata)
 
 renderGWData :: (x -> [(Text, Text)] -> Text) -> GWData x -> GWData y
 renderGWData render gwd = GWData

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

@@ -19,6 +19,7 @@ class Monad m => HandlerReader m where
 
     askYesodRequest :: m YesodRequest
     askHandlerEnv :: m (RunHandlerEnv (HandlerSite m))
+    askHandlerEnvMaster :: m (RunHandlerEnv (HandlerMaster m))
 
 instance HandlerReader (GHandler site) where
     type HandlerSite (GHandler site) = site
@@ -26,6 +27,7 @@ instance HandlerReader (GHandler site) where
 
     askYesodRequest = GHandler $ return . handlerRequest
     askHandlerEnv = GHandler $ return . handlerEnv
+    askHandlerEnvMaster = GHandler $ return . handlerEnv
 
 instance HandlerReader m => HandlerReader (HandlerT site m) where
     type HandlerSite (HandlerT site m) = site
@@ -33,6 +35,7 @@ instance HandlerReader m => HandlerReader (HandlerT site m) where
 
     askYesodRequest = HandlerT $ return . handlerRequest
     askHandlerEnv = HandlerT $ return . handlerEnv
+    askHandlerEnvMaster = lift askHandlerEnvMaster
 
 instance HandlerReader (GWidget site) where
     type HandlerSite (GWidget site) = site
@@ -40,6 +43,7 @@ instance HandlerReader (GWidget site) where
 
     askYesodRequest = lift askYesodRequest
     askHandlerEnv = lift askHandlerEnv
+    askHandlerEnvMaster = lift askHandlerEnvMaster
 
 class HandlerReader m => HandlerState m where
     stateGHState :: (GHState -> (a, GHState)) -> m a

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

@@ -562,12 +562,18 @@ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
     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
+    liftHandler :: GHandler (HandlerSite m) a -> m a
+    liftHandler (GHandler f) = do
+        hd <- askHandlerData
+        liftResourceT $ f hd
+
+    liftHandlerMaster :: GHandler (HandlerMaster m) a -> m a
     askHandlerData :: m (HandlerData (HandlerSite m))
 
 instance Yesod site => MonadHandler (GHandler site) where
     liftHandler = id
+    liftHandlerMaster = id
     askHandlerData = GHandler return
 instance MonadHandler m => MonadHandler (HandlerT site m) where
-    liftHandler = lift . liftHandler
+    liftHandlerMaster = lift . liftHandlerMaster
     askHandlerData = HandlerT return

yesod-core/Yesod/Core/Handler.hs

@@ -417,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 (HandlerSite m) msg)
+setMessageI :: (HandlerState m, RenderMessage (HandlerMaster m) msg)
             => msg -> m ()
 setMessageI msg = do
     mr <- getMessageRender
@@ -490,7 +490,7 @@ permissionDenied :: HandlerError m => Text -> m a
 permissionDenied = hcError . PermissionDenied
 
 -- | Return a 403 permission denied page.
-permissionDeniedI :: (RenderMessage (HandlerSite m) msg, HandlerError m)
+permissionDeniedI :: (RenderMessage (HandlerMaster m) msg, HandlerError m)
                   => msg
                   -> m a
 permissionDeniedI msg = do
@@ -502,7 +502,7 @@ invalidArgs :: HandlerError m => [Text] -> m a
 invalidArgs = hcError . InvalidArgs
 
 -- | Return a 400 invalid arguments page.
-invalidArgsI :: (HandlerError m, RenderMessage (HandlerSite m) msg) => [msg] -> m a
+invalidArgsI :: (HandlerError m, RenderMessage (HandlerMaster m) msg) => [msg] -> m a
 invalidArgsI msg = do
     mr <- getMessageRender
     invalidArgs $ map mr msg
@@ -693,12 +693,12 @@ giveUrlRenderer f = do
 waiRequest :: HandlerReader m => m W.Request
 waiRequest = reqWaiRequest `liftM` getRequest
 
-getMessageRender :: (HandlerReader m, RenderMessage (HandlerSite m) message)
+getMessageRender :: (HandlerReader m, RenderMessage (HandlerMaster m) message)
                  => m (message -> Text)
 getMessageRender = do
-    m <- getYesod
+    env <- askHandlerEnvMaster
     l <- reqLangs `liftM` getRequest
-    return $ renderMessage m l
+    return $ renderMessage (rheSite env) l
 
 -- | Use a per-request cache to avoid performing the same action multiple
 -- times. Note that values are stored by their type. Therefore, you should use

yesod-core/yesod-core.cabal

@@ -95,6 +95,7 @@ library
                      Yesod.Core.Json
                      Yesod.Core.Widget
                      Yesod.Core.Internal
+                     Yesod.Core.Types
     other-modules:   Yesod.Core.Internal.Session
                      Yesod.Core.Internal.Request
                      Yesod.Core.Class.Handler
@@ -105,7 +106,6 @@ library
                      Yesod.Core.Class.Yesod
                      Yesod.Core.Class.Dispatch
                      Yesod.Core.Class.Breadcrumbs
-                     Yesod.Core.Types
                      Yesod.Core.Types.Orphan
                      Paths_yesod_core
     ghc-options:     -Wall

yesod-form/Yesod/Form/Class.hs

@@ -23,7 +23,7 @@ class ToForm a where
 
 class ToField a master where
     toField :: RenderMessage master FormMessage
-            => FieldSettings master -> Maybe a -> AForm sub master a
+            => FieldSettings master -> Maybe a -> AForm master a
 
 {- FIXME
 instance ToFormField String y where

yesod-form/Yesod/Form/Fields.hs

@@ -49,9 +49,7 @@ module Yesod.Form.Fields
 import Yesod.Form.Types
 import Yesod.Form.I18n.English
 import Yesod.Form.Functions (parseHelper)
-import Yesod.Handler (getMessageRender)
-import Yesod.Widget (toWidget, whamlet, GWidget)
-import Yesod.Core (RenderMessage (renderMessage), SomeMessage (..))
+import Yesod.Core
 import Text.Hamlet
 import Text.Blaze (ToMarkup (toMarkup), preEscapedToMarkup, unsafeByteString)
 #define ToHtml ToMarkup
@@ -82,10 +80,6 @@ import Data.Text (Text, unpack, pack)
 import qualified Data.Text.Read
 
 import qualified Data.Map as Map
-import Yesod.Core (newIdent, lift)
-import Yesod.Core (FileInfo)
-
-import Yesod.Core (toPathPiece, GHandler, PathPiece, fromPathPiece)
 import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistQuery)
 import Control.Arrow ((&&&))
 
@@ -97,7 +91,7 @@ defaultFormMessage :: FormMessage -> Text
 defaultFormMessage = englishFormMessage
 
 
-intField :: (Integral i, RenderMessage master FormMessage) => Field sub master i
+intField :: (Integral i, RenderMessage site FormMessage) => Field site i
 intField = Field
     { fieldParse = parseHelper $ \s ->
         case Data.Text.Read.signed Data.Text.Read.decimal s of
@@ -114,7 +108,7 @@ $newline never
     showVal = either id (pack . showI)
     showI x = show (fromIntegral x :: Integer)
 
-doubleField :: RenderMessage master FormMessage => Field sub master Double
+doubleField :: RenderMessage site FormMessage => Field site Double
 doubleField = Field
     { fieldParse = parseHelper $ \s ->
         case Data.Text.Read.double s of
@@ -129,7 +123,7 @@ $newline never
     }
   where showVal = either id (pack . show)
 
-dayField :: RenderMessage master FormMessage => Field sub master Day
+dayField :: RenderMessage site FormMessage => Field site Day
 dayField = Field
     { fieldParse = parseHelper $ parseDate . unpack
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -140,7 +134,7 @@ $newline never
     }
   where showVal = either id (pack . show)
 
-timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
+timeField :: RenderMessage site FormMessage => Field site TimeOfDay
 timeField = Field
     { fieldParse = parseHelper parseTime
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -156,7 +150,7 @@ $newline never
       where
         fullSec = fromInteger $ floor $ todSec tod
 
-htmlField :: RenderMessage master FormMessage => Field sub master Html
+htmlField :: RenderMessage site FormMessage => Field site Html
 htmlField = Field
     { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
@@ -185,7 +179,7 @@ instance ToHtml Textarea where
         writeHtmlEscapedChar '\n' = writeByteString "<br>"
         writeHtmlEscapedChar c    = B.writeHtmlEscapedChar c
 
-textareaField :: RenderMessage master FormMessage => Field sub master Textarea
+textareaField :: RenderMessage site FormMessage => Field site Textarea
 textareaField = Field
     { fieldParse = parseHelper $ Right . Textarea
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
@@ -195,8 +189,8 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-hiddenField :: (PathPiece p, RenderMessage master FormMessage)
-            => Field sub master p
+hiddenField :: (PathPiece p, RenderMessage site FormMessage)
+            => Field site p
 hiddenField = Field
     { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
@@ -206,7 +200,7 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-textField :: RenderMessage master FormMessage => Field sub master Text
+textField :: RenderMessage site FormMessage => Field site Text
 textField = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs val isReq ->
@@ -217,7 +211,7 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-passwordField :: RenderMessage master FormMessage => Field sub master Text
+passwordField :: RenderMessage site FormMessage => Field site Text
 passwordField = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -288,7 +282,7 @@ timeParser = do
             then fail $ show $ msg $ pack xy
             else return $ fromIntegral (i :: Int)
 
-emailField :: RenderMessage master FormMessage => Field sub master Text
+emailField :: RenderMessage site FormMessage => Field site Text
 emailField = Field
     { fieldParse = parseHelper $
         \s ->
@@ -303,7 +297,7 @@ $newline never
     }
 
 type AutoFocus = Bool
-searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
+searchField :: RenderMessage site FormMessage => AutoFocus -> Field site Text
 searchField autoFocus = Field
     { fieldParse = parseHelper Right
     , fieldView = \theId name attrs val isReq -> do
@@ -324,7 +318,7 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-urlField :: RenderMessage master FormMessage => Field sub master Text
+urlField :: RenderMessage site FormMessage => Field site Text
 urlField = Field
     { fieldParse = parseHelper $ \s ->
         case parseURI $ unpack s of
@@ -338,10 +332,10 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
+selectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] -> Field site a
 selectFieldList = selectField . optionsPairs
 
-selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
+selectField :: (Eq a, RenderMessage site FormMessage) => GHandler site (OptionList a) -> Field site a
 selectField = selectFieldHelper
     (\theId name attrs inside -> [whamlet|
 $newline never
@@ -356,12 +350,12 @@ $newline never
 <option value=#{value} :isSel:selected>#{text}
 |]) -- inside
 
-multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
+multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] -> Field site [a]
 multiSelectFieldList = multiSelectField . optionsPairs
 
-multiSelectField :: (Eq a, RenderMessage master FormMessage)
-                 => GHandler sub master (OptionList a)
-                 -> Field sub master [a]
+multiSelectField :: (Eq a, RenderMessage site FormMessage)
+                 => GHandler site (OptionList a)
+                 -> Field site [a]
 multiSelectField ioptlist =
     Field parse view UrlEncoded
   where
@@ -385,10 +379,10 @@ $newline never
             optselected (Left _) _ = False
             optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
 
-radioFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
+radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] -> Field site a
 radioFieldList = radioField . optionsPairs
 
-radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
+radioField :: (Eq a, RenderMessage site FormMessage) => GHandler site (OptionList a) -> Field site a
 radioField = selectFieldHelper
     (\theId _name _attrs inside -> [whamlet|
 $newline never
@@ -409,7 +403,7 @@ $newline never
         \#{text}
 |])
 
-boolField :: RenderMessage master FormMessage => Field sub master Bool
+boolField :: RenderMessage site FormMessage => Field site Bool
 boolField = Field
       { fieldParse = \e _ -> return $ boolParser e
       , fieldView = \theId name attrs val isReq -> [whamlet|
@@ -445,7 +439,7 @@ $newline never
 --
 --   Note that this makes the field always optional.
 --
-checkBoxField :: RenderMessage m FormMessage => Field s m Bool
+checkBoxField :: RenderMessage site FormMessage => Field site Bool
 checkBoxField = Field
     { fieldParse = \e _ -> return $ checkBoxParser e
     , fieldView  = \theId name attrs val _ -> [whamlet|
@@ -481,7 +475,7 @@ data Option a = Option
     , optionExternalValue :: Text
     }
 
-optionsPairs :: RenderMessage master msg => [(msg, a)] -> GHandler sub master (OptionList a)
+optionsPairs :: RenderMessage site msg => [(msg, a)] -> GHandler site (OptionList a)
 optionsPairs opts = do
   mr <- getMessageRender
   let mkOption external (display, internal) =
@@ -491,16 +485,16 @@ optionsPairs opts = do
                  }
   return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts)
 
-optionsEnum :: (Show a, Enum a, Bounded a) => GHandler sub master (OptionList a)
+optionsEnum :: (Show a, Enum a, Bounded a) => GHandler site (OptionList a)
 optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 
-optionsPersist :: ( YesodPersist master, PersistEntity a
-                  , PersistQuery (YesodPersistBackend master (GHandler sub master))
+optionsPersist :: ( YesodPersist site, PersistEntity a
+                  , PersistQuery (YesodPersistBackend site (GHandler site))
                   , PathPiece (Key a)
-                  , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend master (GHandler sub master))
-                  , RenderMessage master msg
+                  , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (GHandler site))
+                  , RenderMessage site msg
                   )
-               => [Filter a] -> [SelectOpt a] -> (a -> msg) -> GHandler sub master (OptionList (Entity a))
+               => [Filter a] -> [SelectOpt a] -> (a -> msg) -> GHandler site (OptionList (Entity a))
 optionsPersist filts ords toDisplay = fmap mkOptionList $ do
     mr <- getMessageRender
     pairs <- runDB $ selectList filts ords
@@ -511,11 +505,11 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do
         }) pairs
 
 selectFieldHelper
-        :: (Eq a, RenderMessage master FormMessage)
-        => (Text -> Text -> [(Text, Text)] -> GWidget sub master () -> GWidget sub master ())
-        -> (Text -> Text -> Bool -> GWidget sub master ())
-        -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget sub master ())
-        -> GHandler sub master (OptionList a) -> Field sub master a
+        :: (Eq a, RenderMessage site FormMessage)
+        => (Text -> Text -> [(Text, Text)] -> GWidget site () -> GWidget site ())
+        -> (Text -> Text -> Bool -> GWidget site ())
+        -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget site ())
+        -> GHandler site (OptionList a) -> Field site a
 selectFieldHelper outside onOpt inside opts' = Field
     { fieldParse = \x _ -> do
         opts <- opts'
@@ -544,7 +538,7 @@ selectFieldHelper outside onOpt inside opts' = Field
                     Nothing -> Left $ SomeMessage $ MsgInvalidEntry x
                     Just y -> Right $ Just y
 
-fileField :: RenderMessage master FormMessage => Field sub master FileInfo
+fileField :: RenderMessage site FormMessage => Field site FileInfo
 fileField = Field
     { fieldParse = \_ files -> return $
         case files of
@@ -556,8 +550,8 @@ fileField = Field
     , fieldEnctype = Multipart
     }
 
-fileAFormReq :: RenderMessage master FormMessage => FieldSettings master -> AForm sub master FileInfo
-fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
+fileAFormReq :: RenderMessage site FormMessage => FieldSettings site -> AForm site FileInfo
+fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
     let (name, ints') =
             case fsName fs of
                 Just x -> (x, ints)
@@ -572,11 +566,11 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
                     case Map.lookup name fenv of
                         Just (fi:_) -> (FormSuccess fi, Nothing)
                         _ ->
-                            let t = renderMessage master langs MsgValueRequired
+                            let t = renderMessage site langs MsgValueRequired
                              in (FormFailure [t], Just $ toHtml t)
     let fv = FieldView
-            { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
-            , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
+            { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs
+            , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs
             , fvId = id'
             , fvInput = [whamlet|
 $newline never
@@ -587,7 +581,7 @@ $newline never
             }
     return (res, (fv :), ints', Multipart)
 
-fileAFormOpt :: RenderMessage master FormMessage => FieldSettings master -> AForm sub master (Maybe FileInfo)
+fileAFormOpt :: RenderMessage site FormMessage => FieldSettings site -> AForm site (Maybe FileInfo)
 fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
     let (name, ints') =
             case fsName fs of

yesod-form/Yesod/Form/Functions.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -42,33 +43,27 @@ module Yesod.Form.Functions
     , parseHelper
     ) where
 
+import Control.Monad.Trans.Resource (MonadResource)
 import Yesod.Form.Types
 import Data.Text (Text, pack)
 import Control.Arrow (second)
 import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
-import Control.Monad.Trans.Class (lift)
 import Control.Monad (liftM, join)
 import Crypto.Classes (constTimeEq)
 import Text.Blaze (Markup, toMarkup)
 #define Html Markup
 #define toHtml toMarkup
-import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
-import Yesod.Core (RenderMessage, SomeMessage (..))
-import Yesod.Widget (GWidget, whamlet)
-import Yesod.Core (reqToken, reqWaiRequest, reqGetParams, languages)
+import Yesod.Core
 import Network.Wai (requestMethod)
 import Text.Hamlet (shamlet)
 import Data.Monoid (mempty)
 import Data.Maybe (listToMaybe, fromMaybe)
-import Yesod.Core (RenderMessage (..))
 import qualified Data.Map as Map
 import qualified Data.Text.Encoding as TE
-import Control.Applicative ((<$>))
 import Control.Arrow (first)
-import Yesod.Core (FileInfo)
 
 -- | Get a unique identifier.
-newFormIdent :: MForm sub master Text
+newFormIdent :: MForm site Text
 newFormIdent = do
     i <- get
     let i' = incrInts i
@@ -78,54 +73,54 @@ newFormIdent = do
     incrInts (IntSingle i) = IntSingle $ i + 1
     incrInts (IntCons i is) = (i + 1) `IntCons` is
 
-formToAForm :: MForm sub master (FormResult a, [FieldView sub master]) -> AForm sub master a
-formToAForm form = AForm $ \(master, langs) env ints -> do
-    ((a, xmls), ints', enc) <- runRWST form (env, master, langs) ints
+formToAForm :: MForm site (FormResult a, [FieldView site]) -> AForm site a
+formToAForm form = AForm $ \(site, langs) env ints -> do
+    ((a, xmls), ints', enc) <- runRWST form (env, site, langs) ints
     return (a, (++) xmls, ints', enc)
 
-aFormToForm :: AForm sub master a -> MForm sub master (FormResult a, [FieldView sub master] -> [FieldView sub master])
+aFormToForm :: AForm site a -> MForm site (FormResult a, [FieldView site] -> [FieldView site])
 aFormToForm (AForm aform) = do
     ints <- get
-    (env, master, langs) <- ask
-    (a, xml, ints', enc) <- lift $ aform (master, langs) env ints
+    (env, site, langs) <- ask
+    (a, xml, ints', enc) <- lift $ aform (site, langs) env ints
     put ints'
     tell enc
     return (a, xml)
 
-askParams :: MForm sub master (Maybe Env)
+askParams :: MForm site (Maybe Env)
 askParams = do
     (x, _, _) <- ask
     return $ liftM fst x
 
-askFiles :: MForm sub master (Maybe FileEnv)
+askFiles :: MForm site (Maybe FileEnv)
 askFiles = do
     (x, _, _) <- ask
     return $ liftM snd x
 
-mreq :: RenderMessage master FormMessage
-     => Field sub master a -> FieldSettings master -> Maybe a
-     -> MForm sub master (FormResult a, FieldView sub master)
+mreq :: RenderMessage site FormMessage
+     => Field site a -> FieldSettings site -> Maybe a
+     -> MForm site (FormResult a, FieldView site)
 mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True
 
-mopt :: Field sub master a -> FieldSettings master -> Maybe (Maybe a)
-     -> MForm sub master (FormResult (Maybe a), FieldView sub master)
+mopt :: Field site a -> FieldSettings site -> Maybe (Maybe a)
+     -> MForm site (FormResult (Maybe a), FieldView site)
 mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False
 
-mhelper :: Field sub master a
-        -> FieldSettings master
+mhelper :: Field site a
+        -> FieldSettings site
         -> Maybe a
-        -> (master -> [Text] -> FormResult b) -- ^ on missing
+        -> (site -> [Text] -> FormResult b) -- ^ on missing
         -> (a -> FormResult b) -- ^ on success
         -> Bool -- ^ is it required?
-        -> MForm sub master (FormResult b, FieldView sub master)
+        -> MForm site (FormResult b, FieldView site)
 
 mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
     tell fieldEnctype
     mp <- askParams
     name <- maybe newFormIdent return fsName
     theId <- lift $ maybe newIdent return fsId
-    (_, master, langs) <- ask
-    let mr2 = renderMessage master langs
+    (_, site, langs) <- ask
+    let mr2 = renderMessage site langs
     (res, val) <-
         case mp of
             Nothing -> return (FormMissing, maybe (Left "") Right mdef)
@@ -135,10 +130,10 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
                     files = fromMaybe [] $ mfs >>= Map.lookup name
                 emx <- lift $ fieldParse mvals files
                 return $ case emx of
-                    Left (SomeMessage e) -> (FormFailure [renderMessage master langs e], maybe (Left "") Left (listToMaybe mvals))
+                    Left (SomeMessage e) -> (FormFailure [renderMessage site langs e], maybe (Left "") Left (listToMaybe mvals))
                     Right mx ->
                         case mx of
-                            Nothing -> (onMissing master langs, Left "")
+                            Nothing -> (onMissing site langs, Left "")
                             Just x -> (onFound x, Right x)
     return (res, FieldView
         { fvLabel = toHtml $ mr2 fsLabel
@@ -152,19 +147,24 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
         , fvRequired = isReq
         })
 
-areq :: RenderMessage master FormMessage
-     => Field sub master a -> FieldSettings master -> Maybe a
-     -> AForm sub master a
+areq :: RenderMessage site FormMessage
+     => Field site a -> FieldSettings site -> Maybe a
+     -> AForm site a
 areq a b = formToAForm . fmap (second return) . mreq a b
 
-aopt :: Field sub master a
-     -> FieldSettings master
+aopt :: Field site a
+     -> FieldSettings site
      -> Maybe (Maybe a)
-     -> AForm sub master (Maybe a)
+     -> AForm site (Maybe a)
 aopt a b = formToAForm . fmap (second return) . mopt a b
 
-runFormGeneric :: MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
-runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1)
+runFormGeneric :: MonadHandler m
+               => MForm (HandlerSite m) a
+               -> HandlerSite m
+               -> [Text]
+               -> Maybe (Env, FileEnv)
+               -> m (a, Enctype)
+runFormGeneric form site langs env = liftHandler $ evalRWST form (env, site, langs) (IntSingle 1)
 
 -- | This function is used to both initially render a form and to later extract
 -- results from it. Note that, due to CSRF protection and a few other issues,
@@ -175,27 +175,24 @@ runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSi
 -- For example, a common case is displaying a form on a GET request and having
 -- the form submit to a POST page. In such a case, both the GET and POST
 -- handlers should use 'runFormPost'.
-runFormPost :: RenderMessage master FormMessage
-            => (Html -> MForm sub master (FormResult a, xml))
-            -> GHandler sub master ((FormResult a, xml), Enctype)
+runFormPost :: (HandlerSite m ~ site, RenderMessage site FormMessage, MonadResource m, MonadHandler m)
+            => (Html -> MForm site (FormResult a, xml))
+            -> m ((FormResult a, xml), Enctype)
 runFormPost form = do
     env <- postEnv
     postHelper form env
 
-postHelper  :: RenderMessage master FormMessage
-            => (Html -> MForm sub master (FormResult a, xml))
+postHelper  :: (site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m)
+            => (Html -> MForm site (FormResult a, xml))
             -> Maybe (Env, FileEnv)
-            -> GHandler sub master ((FormResult a, xml), Enctype)
+            -> m ((FormResult a, xml), Enctype)
 postHelper form env = do
     req <- getRequest
     let tokenKey = "_token"
     let token =
             case reqToken req of
                 Nothing -> mempty
-                Just n -> [shamlet|
-$newline never
-<input type=hidden name=#{tokenKey} value=#{n}>
-|]
+                Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
     m <- getYesod
     langs <- languages
     ((res, xml), enctype) <- runFormGeneric (form token) m langs env
@@ -215,12 +212,13 @@ $newline never
 -- page will both receive and incoming form and produce a new, blank form. For
 -- general usage, you can stick with @runFormPost@.
 generateFormPost
-    :: RenderMessage master FormMessage
-    => (Html -> MForm sub master (FormResult a, xml))
-    -> GHandler sub master (xml, Enctype)
-generateFormPost form = first snd <$> postHelper form Nothing
+    :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage)
+    => (Html -> MForm (HandlerSite m) (FormResult a, xml))
+    -> m (xml, Enctype)
+generateFormPost form = first snd `liftM` postHelper form Nothing
 
-postEnv :: GHandler sub master (Maybe (Env, FileEnv))
+postEnv :: (HandlerState m, MonadResource m)
+        => m (Maybe (Env, FileEnv))
 postEnv = do
     req <- getRequest
     if requestMethod (reqWaiRequest req) == "GET"
@@ -230,14 +228,18 @@ postEnv = do
             let p' = Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) p
             return $ Just (p', Map.unionsWith (++) $ map (\(k, v) -> Map.singleton k [v]) f)
 
-runFormPostNoToken :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
+runFormPostNoToken :: (MonadHandler m)
+                   => (Html -> MForm (HandlerSite m) (FormResult a, xml))
+                   -> m ((FormResult a, xml), Enctype)
 runFormPostNoToken form = do
     langs <- languages
     m <- getYesod
     env <- postEnv
     runFormGeneric (form mempty) m langs env
 
-runFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype)
+runFormGet :: MonadHandler m
+           => (Html -> MForm (HandlerSite m) a)
+           -> m (a, Enctype)
 runFormGet form = do
     gets <- liftM reqGetParams getRequest
     let env =
@@ -246,28 +248,30 @@ runFormGet form = do
                 Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty)
     getHelper form env
 
-generateFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype)
+generateFormGet :: MonadHandler m
+                => (Html -> MForm (HandlerSite m) a)
+                -> m (a, Enctype)
 generateFormGet form = getHelper form Nothing
 
 getKey :: Text
 getKey = "_hasdata"
 
-getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
+getHelper :: MonadHandler m
+          => (Html -> MForm (HandlerSite m) a)
+          -> Maybe (Env, FileEnv)
+          -> m (a, Enctype)
 getHelper form env = do
-    let fragment = [shamlet|
-$newline never
-<input type=hidden name=#{getKey}>
-|]
+    let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
     langs <- languages
     m <- getYesod
     runFormGeneric (form fragment) m langs env
 
-type FormRender sub master a =
-       AForm sub master a
+type FormRender site a =
+       AForm site a
     -> Html
-    -> MForm sub master (FormResult a, GWidget sub master ())
+    -> MForm site (FormResult a, GWidget site ())
 
-renderTable, renderDivs, renderDivsNoLabels :: FormRender sub master a
+renderTable, renderDivs, renderDivsNoLabels :: FormRender site a
 renderTable aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -292,7 +296,7 @@ renderDivs = renderDivsMaybeLabels True
 -- | render a field inside a div, not displaying any label
 renderDivsNoLabels = renderDivsMaybeLabels False
 
-renderDivsMaybeLabels :: Bool -> FormRender sub master a
+renderDivsMaybeLabels :: Bool -> FormRender site a
 renderDivsMaybeLabels withLabels aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -326,7 +330,7 @@ $forall view <- views
 -- >      ^{formWidget}
 -- >      <div .form-actions>
 -- >        <input .btn .primary type=submit value=_{MsgSubmit}>
-renderBootstrap :: FormRender sub master a
+renderBootstrap :: FormRender site a
 renderBootstrap aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -347,19 +351,19 @@ $forall view <- views
 |]
     return (res, widget)
 
-check :: RenderMessage master msg
-      => (a -> Either msg a) -> Field sub master a -> Field sub master a
+check :: RenderMessage site msg
+      => (a -> Either msg a) -> Field site a -> Field site a
 check f = checkM $ return . f
 
 -- | Return the given error message if the predicate is false.
-checkBool :: RenderMessage master msg
-          => (a -> Bool) -> msg -> Field sub master a -> Field sub master a
+checkBool :: RenderMessage site msg
+          => (a -> Bool) -> msg -> Field site a -> Field site a
 checkBool b s = check $ \x -> if b x then Right x else Left s
 
-checkM :: RenderMessage master msg
-       => (a -> GHandler sub master (Either msg a))
-       -> Field sub master a
-       -> Field sub master a
+checkM :: RenderMessage site msg
+       => (a -> GHandler site (Either msg a))
+       -> Field site a
+       -> Field site a
 checkM f = checkMMap f id
 
 -- | Same as 'checkM', but modifies the datatype.
@@ -368,11 +372,11 @@ checkM f = checkMMap f id
 -- the new datatype to the old one (the second argument to this function).
 --
 -- Since 1.1.2
-checkMMap :: RenderMessage master msg
-          => (a -> GHandler sub master (Either msg b))
+checkMMap :: RenderMessage site msg
+          => (a -> GHandler site (Either msg b))
           -> (b -> a)
-          -> Field sub master a
-          -> Field sub master b
+          -> Field site a
+          -> Field site b
 checkMMap f inv field = field
     { fieldParse = \ts fs -> do
         e1 <- fieldParse field ts fs
@@ -386,25 +390,25 @@ checkMMap f inv field = field
 -- | Deprecated synonym for 'checkMMap'.
 --
 -- Since 1.1.1
-checkMMod :: RenderMessage master msg
-          => (a -> GHandler sub master (Either msg b))
+checkMMod :: RenderMessage site msg
+          => (a -> GHandler site (Either msg b))
           -> (b -> a)
-          -> Field sub master a
-          -> Field sub master b
+          -> Field site a
+          -> Field site b
 checkMMod = checkMMap
 {-# DEPRECATED checkMMod "Please use checkMMap instead" #-}
 
 -- | Allows you to overwrite the error message on parse error.
-customErrorMessage :: SomeMessage master -> Field sub master a -> Field sub master a
+customErrorMessage :: SomeMessage site -> Field site a -> Field site a
 customErrorMessage msg field = field { fieldParse = \ts fs -> fmap (either
 (const $ Left msg) Right) $ fieldParse field ts fs }
 
 -- | Generate a 'FieldSettings' from the given label.
-fieldSettingsLabel :: RenderMessage master msg => msg -> FieldSettings master
+fieldSettingsLabel :: RenderMessage site msg => msg -> FieldSettings site
 fieldSettingsLabel msg = FieldSettings (SomeMessage msg) Nothing Nothing Nothing []
 
 -- | Generate an 'AForm' that gets its value from the given action.
-aformM :: GHandler sub master a -> AForm sub master a
+aformM :: GHandler site a -> AForm site a
 aformM action = AForm $ \_ _ ints -> do
     value <- action
     return (FormSuccess value, id, ints, mempty)
@@ -415,9 +419,9 @@ aformM action = AForm $ \_ _ ints -> do
 -- required, such as when parsing a text field.
 --
 -- Since 1.1
-parseHelper :: (Monad m, RenderMessage master FormMessage)
+parseHelper :: (Monad m, RenderMessage site FormMessage)
             => (Text -> Either FormMessage a)
-            -> [Text] -> [FileInfo] -> m (Either (SomeMessage master) (Maybe a))
+            -> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
 parseHelper _ [] _ = return $ Right Nothing
 parseHelper _ ("":_) _ = return $ Right Nothing
 parseHelper f (x:_) _ = return $ either (Left . SomeMessage) (Right . Just) $ f x

yesod-form/Yesod/Form/Input.hs

@@ -11,19 +11,17 @@ module Yesod.Form.Input
 import Yesod.Form.Types
 import Data.Text (Text)
 import Control.Applicative (Applicative (..))
-import Yesod.Handler (GHandler, invalidArgs, runRequestBody, getRequest, getYesod)
-import Yesod.Core (reqGetParams, languages)
+import Yesod.Core
 import Control.Monad (liftM)
-import Yesod.Core (RenderMessage (..), SomeMessage (..))
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 import Control.Arrow ((***))
 
 type DText = [Text] -> [Text]
-newtype FormInput sub master a = FormInput { unFormInput :: master -> [Text] -> Env -> FileEnv -> GHandler sub master (Either DText a) }
-instance Functor (FormInput sub master) where
+newtype FormInput site a = FormInput { unFormInput :: site -> [Text] -> Env -> FileEnv -> GHandler site (Either DText a) }
+instance Functor (FormInput site) where
     fmap a (FormInput f) = FormInput $ \c d e e' -> fmap (either Left (Right . a)) $ f c d e e'
-instance Applicative (FormInput sub master) where
+instance Applicative (FormInput site) where
     pure = FormInput . const . const . const . const . return . Right
     (FormInput f) <*> (FormInput x) = FormInput $ \c d e e' -> do
         res1 <- f c d e e'
@@ -34,7 +32,7 @@ instance Applicative (FormInput sub master) where
             (_, Left b) -> Left b
             (Right a, Right b) -> Right $ a b
 
-ireq :: (RenderMessage master FormMessage) => Field sub master a -> Text -> FormInput sub master a
+ireq :: (RenderMessage site FormMessage) => Field site a -> Text -> FormInput site a
 ireq field name = FormInput $ \m l env fenv -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
           filteredFEnv = fromMaybe [] $ Map.lookup name fenv
@@ -44,7 +42,7 @@ ireq field name = FormInput $ \m l env fenv -> do
           Right Nothing -> Left $ (:) $ renderMessage m l $ MsgInputNotFound name
           Right (Just a) -> Right a
 
-iopt :: Field sub master a -> Text -> FormInput sub master (Maybe a)
+iopt :: Field site a -> Text -> FormInput site (Maybe a)
 iopt field name = FormInput $ \m l env fenv -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
           filteredFEnv = fromMaybe [] $ Map.lookup name fenv
@@ -53,12 +51,12 @@ iopt field name = FormInput $ \m l env fenv -> do
         Left (SomeMessage e) -> Left $ (:) $ renderMessage m l e
         Right x -> Right x
 
-runInputGet :: FormInput sub master a -> GHandler sub master a
+runInputGet :: MonadHandler m => FormInput (HandlerSite m) a -> m a
 runInputGet (FormInput f) = do
     env <- liftM (toMap . reqGetParams) getRequest
     m <- getYesod
     l <- languages
-    emx <- f m l env Map.empty
+    emx <- liftHandler $ f m l env Map.empty
     case emx of
         Left errs -> invalidArgs $ errs []
         Right x -> return x
@@ -66,12 +64,12 @@ runInputGet (FormInput f) = do
 toMap :: [(Text, a)] -> Map.Map Text [a]
 toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y])
 
-runInputPost :: FormInput sub master a -> GHandler sub master a
+runInputPost :: MonadHandler m => FormInput (HandlerSite m) a -> m a
 runInputPost (FormInput f) = do
     (env, fenv) <- liftM (toMap *** toMap) runRequestBody
     m <- getYesod
     l <- languages
-    emx <- f m l env fenv
+    emx <- liftHandler $ f m l env fenv
     case emx of
         Left errs -> invalidArgs $ errs []
         Right x -> return x

yesod-form/Yesod/Form/Jquery.hs

@@ -53,7 +53,7 @@ class YesodJquery a where
     urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
     urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
 
-jqueryDayField :: (RenderMessage master FormMessage, YesodJquery master) => JqueryDaySettings -> Field sub master Day
+jqueryDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field site Day
 jqueryDayField jds = Field
     { fieldParse = parseHelper $ maybe
                   (Left MsgInvalidDay)
@@ -97,8 +97,8 @@ $(function(){
         , "]"
         ]
 
-jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master)
-                        => Route master -> Field sub master Text
+jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)
+                        => Route site -> Field site Text
 jqueryAutocompleteField src = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs val isReq -> do
@@ -115,12 +115,12 @@ $(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})});
     , fieldEnctype = UrlEncoded
     }
 
-addScript' :: (master -> Either (Route master) Text) -> GWidget sub master ()
+addScript' :: (site -> Either (Route site) Text) -> GWidget site ()
 addScript' f = do
     y <- lift getYesod
     addScriptEither $ f y
 
-addStylesheet' :: (y -> Either (Route y) Text) -> GWidget sub y ()
+addStylesheet' :: (site -> Either (Route site) Text) -> GWidget site ()
 addStylesheet' f = do
     y <- lift getYesod
     addStylesheetEither $ f y

yesod-form/Yesod/Form/MassInput.hs

@@ -12,11 +12,8 @@ module Yesod.Form.MassInput
 import Yesod.Form.Types
 import Yesod.Form.Functions
 import Yesod.Form.Fields (boolField)
-import Yesod.Widget (GWidget, whamlet)
-import Yesod.Core (RenderMessage)
-import Yesod.Handler (newIdent, GHandler)
+import Yesod.Core
 import Text.Blaze.Html (Html)
-import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.RWS (get, put, ask)
 import Data.Maybe (fromMaybe)
 import Data.Text.Read (decimal)
@@ -25,9 +22,8 @@ import Data.Either (partitionEithers)
 import Data.Traversable (sequenceA)
 import qualified Data.Map as Map
 import Data.Maybe (listToMaybe)
-import Yesod.Core (SomeMessage (SomeMessage))
 
-down :: Int -> MForm sub master ()
+down :: Int -> MForm site ()
 down 0 = return ()
 down i | i < 0 = error "called down with a negative number"
 down i = do
@@ -35,7 +31,7 @@ down i = do
     put $ IntCons 0 is
     down $ i - 1
 
-up :: Int -> MForm sub master ()
+up :: Int -> MForm site ()
 up 0 = return ()
 up i | i < 0 = error "called down with a negative number"
 up i = do
@@ -45,11 +41,11 @@ up i = do
         IntCons _ is' -> put is' >> newFormIdent >> return ()
     up $ i - 1
 
-inputList :: (m ~ GHandler sub master, xml ~ GWidget sub master (), RenderMessage master FormMessage)
+inputList :: (m ~ GHandler site, xml ~ GWidget site (), RenderMessage site FormMessage)
           => Html
-          -> ([[FieldView sub master]] -> xml)
-          -> (Maybe a -> AForm sub master a)
-          -> (Maybe [a] -> AForm sub master [a])
+          -> ([[FieldView site]] -> xml)
+          -> (Maybe a -> AForm site a)
+          -> (Maybe [a] -> AForm site [a])
 inputList label fixXml single mdef = formToAForm $ do
     theId <- lift newIdent
     down 1
@@ -89,9 +85,9 @@ $newline never
         , fvRequired = False
         }])
 
-withDelete :: (xml ~ GWidget sub master (), RenderMessage master FormMessage)
-           => AForm sub master a
-           -> MForm sub master (Either xml (FormResult a, [FieldView sub master]))
+withDelete :: (xml ~ GWidget site (), RenderMessage site FormMessage)
+           => AForm site a
+           -> MForm site (Either xml (FormResult a, [FieldView site]))
 withDelete af = do
     down 1
     deleteName <- newFormIdent
@@ -114,9 +110,9 @@ $newline never
     up 1
     return res
 
-fixme :: (xml ~ GWidget sub master ())
-      => [Either xml (FormResult a, [FieldView sub master])]
-      -> (FormResult [a], [xml], [[FieldView sub master]])
+fixme :: (xml ~ GWidget site ())
+      => [Either xml (FormResult a, [FieldView site])]
+      -> (FormResult [a], [xml], [[FieldView site]])
 fixme eithers =
     (res, xmls, map snd rest)
   where
@@ -124,8 +120,8 @@ fixme eithers =
     res = sequenceA $ map fst rest
 
 massDivs, massTable
-         :: [[FieldView sub master]]
-         -> GWidget sub master ()
+         :: [[FieldView site]]
+         -> GWidget site ()
 massDivs viewss = [whamlet|
 $newline never
 $forall views <- viewss

yesod-form/Yesod/Form/Nic.hs

@@ -24,7 +24,7 @@ class Yesod a => YesodNic a where
     urlNicEdit :: a -> Either (Route a) Text
     urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
 
-nicHtmlField :: YesodNic master => Field sub master Html
+nicHtmlField :: YesodNic site => Field site Html
 nicHtmlField = Field
     { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
     , fieldView = \theId name attrs val _isReq -> do
@@ -47,7 +47,7 @@ bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{ra
   where
     showVal = either id (pack . renderHtml)
 
-addScript' :: (y -> Either (Route y) Text) -> GWidget sub y ()
+addScript' :: (site -> Either (Route site) Text) -> GWidget site ()
 addScript' f = do
     y <- lift getYesod
     addScriptEither $ f y

yesod-form/Yesod/Form/Types.hs

@@ -80,26 +80,26 @@ type Env = Map.Map Text [Text]
 type FileEnv = Map.Map Text [FileInfo]
 
 type Lang = Text
-type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandler sub master) a
+type MForm site a = RWST (Maybe (Env, FileEnv), site, [Lang]) Enctype Ints (GHandler site) a
 
-newtype AForm sub master a = AForm
-    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GHandler sub master (FormResult a, [FieldView sub master] -> [FieldView sub master], Ints, Enctype)
+newtype AForm site a = AForm
+    { unAForm :: (site, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GHandler site (FormResult a, [FieldView site] -> [FieldView site], Ints, Enctype)
     }
-instance Functor (AForm sub master) where
+instance Functor (AForm site) where
     fmap f (AForm a) =
         AForm $ \x y z -> liftM go $ a x y z
       where
         go (w, x, y, z) = (fmap f w, x, y, z)
-instance Applicative (AForm sub master) where
+instance Applicative (AForm site) where
     pure x = AForm $ const $ const $ \ints -> return (FormSuccess x, mempty, ints, mempty)
     (AForm f) <*> (AForm g) = AForm $ \mr env ints -> do
         (a, b, ints', c) <- f mr env ints
         (x, y, ints'', z) <- g mr env ints'
         return (a <*> x, b `mappend` y, ints'', c `mappend` z)
-instance Monoid a => Monoid (AForm sub master a) where
+instance Monoid a => Monoid (AForm site a) where
     mempty = pure mempty
     mappend a b = mappend <$> a <*> b
-instance MonadLift (GHandler sub master) (AForm sub master) where
+instance MonadLift (GHandler site) (AForm site) where
     lift f = AForm $ \_ _ ints -> do
         x <- f
         return (FormSuccess x, id, ints, mempty)
@@ -115,26 +115,26 @@ data FieldSettings master = FieldSettings
 instance IsString (FieldSettings a) where
     fromString s = FieldSettings (fromString s) Nothing Nothing Nothing []
 
-data FieldView sub master = FieldView
+data FieldView site = FieldView
     { fvLabel :: Html
     , fvTooltip :: Maybe Html
     , fvId :: Text
-    , fvInput :: GWidget sub master ()
+    , fvInput :: GWidget site ()
     , fvErrors :: Maybe Html
     , fvRequired :: Bool
     }
 
-type FieldViewFunc sub master a
+type FieldViewFunc site a
     = Text -- ^ ID
    -> Text -- ^ Name
    -> [(Text, Text)] -- ^ Attributes
    -> Either Text a -- ^ Either (invalid text) or (legitimate result)
    -> Bool -- ^ Required?
-   -> GWidget sub master ()
+   -> GWidget site ()
 
-data Field sub master a = Field
-    { fieldParse :: [Text] -> [FileInfo] -> GHandler sub master (Either (SomeMessage master) (Maybe a))
-    , fieldView :: FieldViewFunc sub master a
+data Field site a = Field
+    { fieldParse :: [Text] -> [FileInfo] -> GHandler site (Either (SomeMessage site) (Maybe a))
+    , fieldView :: FieldViewFunc site a
     , fieldEnctype :: Enctype
     }
 

yesod-form/yesod-form.cabal

@@ -37,6 +37,7 @@ library
                    , attoparsec            >= 0.10
                    , crypto-api            >= 0.8
                    , aeson
+                   , resourcet
 
     exposed-modules: Yesod.Form
                      Yesod.Form.Class

yesod-newsfeed/Yesod/AtomFeed.hs

@@ -42,7 +42,7 @@ instance HasContentType RepAtom where
 instance ToTypedContent RepAtom where
     toTypedContent = TypedContent typeAtom . toContent
 
-atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
+atomFeed :: Feed (Route site) -> GHandler site RepAtom
 atomFeed feed = do
     render <- getUrlRender
     return $ RepAtom $ toContent $ renderLBS def $ template feed render
@@ -75,9 +75,9 @@ entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElemen
     ]
 
 -- | Generates a link tag in the head of a widget.
-atomLink :: Route m
+atomLink :: Route site
          -> Text -- ^ title
-         -> GWidget s m ()
+         -> GWidget site ()
 atomLink r title = toWidgetHead [hamlet|
 $newline never
 <link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>

yesod-newsfeed/Yesod/Feed.hs

@@ -25,7 +25,7 @@ import Yesod.AtomFeed
 import Yesod.RssFeed
 import Yesod.Core
 
-newsFeed :: Feed (Route master) -> GHandler sub master TypedContent
+newsFeed :: Feed (Route site) -> GHandler site TypedContent
 newsFeed f = selectRep $ do
     provideRep $ atomFeed f
     provideRep $ rssFeed f

yesod-newsfeed/Yesod/RssFeed.hs

@@ -39,7 +39,7 @@ instance ToTypedContent RepRss where
     toTypedContent = TypedContent typeRss . toContent
 
 -- | Generate the feed
-rssFeed :: Feed (Route master) -> GHandler sub master RepRss
+rssFeed :: Feed (Route site) -> GHandler site RepRss
 rssFeed feed = do
     render <- getUrlRender
     return $ RepRss $ toContent $ renderLBS def $ template feed render
@@ -71,9 +71,9 @@ entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement
     ]
 
 -- | Generates a link tag in the head of a widget.
-rssLink :: Route m
+rssLink :: Route site
         -> Text -- ^ title
-        -> GWidget s m ()
+        -> GWidget site ()
 rssLink r title = toWidgetHead [hamlet|
 $newline never
     <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>

yesod-persistent/Yesod/Persist.hs

@@ -16,17 +16,17 @@ import Control.Monad.Trans.Class (MonadTrans)
 
 import Yesod.Core
 
-type YesodDB sub master = YesodPersistBackend master (GHandler sub master)
+type YesodDB site = YesodPersistBackend site (GHandler site)
 
-class YesodPersist master where
-    type YesodPersistBackend master :: (* -> *) -> * -> *
-    runDB :: YesodDB sub master a -> GHandler sub master a
+class YesodPersist site where
+    type YesodPersistBackend site :: (* -> *) -> * -> *
+    runDB :: YesodDB site a -> GHandler site a
 
 -- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
 get404 :: ( PersistStore (t m)
           , PersistEntity val
           , Monad (t m)
-          , m ~ GHandler sub master
+          , m ~ GHandler site
           , MonadTrans t
           , PersistMonadBackend (t m) ~ PersistEntityBackend val
           )
@@ -41,7 +41,7 @@ get404 key = do
 --   exist.
 getBy404 :: ( PersistUnique (t m)
             , PersistEntity val
-            , m ~ GHandler sub master
+            , m ~ GHandler site
             , Monad (t m)
             , MonadTrans t
             , PersistEntityBackend val ~ PersistMonadBackend (t m)

yesod-sitemap/Yesod/Sitemap.hs

@@ -75,15 +75,15 @@ template urls render =
         , Element "priority" Map.empty [NodeContent $ pack $ show sitemapPriority]
         ]
 
-sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml
+sitemap :: [SitemapUrl (Route site)] -> GHandler site RepXml
 sitemap urls = do
     render <- getUrlRender
     let doc = template urls render
     return $ RepXml $ toContent $ renderLBS def doc
 
 -- | A basic robots file which just lists the "Sitemap: " line.
-robots :: Route master -- ^ sitemap url
-       -> GHandler sub master RepPlain
+robots :: Route site -- ^ sitemap url
+       -> GHandler site RepPlain
 robots smurl = do
     render <- getUrlRender
     return $ RepPlain $ toContent $ "Sitemap: " `mappend` render smurl

yesod-static/Yesod/Static.hs

@@ -53,6 +53,7 @@ import Control.Monad
 import Data.FileEmbed (embedDir)
 
 import Yesod.Core hiding (lift)
+import Yesod.Core.Types
 
 import Data.List (intercalate)
 import Language.Haskell.TH
@@ -142,9 +143,11 @@ instance RenderRoute Static where
         deriving (Eq, Show, Read)
     renderRoute (StaticRoute x y) = (x, y)
 
-instance Yesod master => YesodDispatch Static master where
-    yesodDispatch _ _ (Static set) _ _ _ _ textPieces  _ req =
-        staticApp set req { pathInfo = textPieces }
+instance YesodSubDispatch Static m where
+    yesodSubDispatch _run getSub _toMaster env req =
+        staticApp set req
+      where
+        Static set = getSub $ yreSite env
 
 notHidden :: Prelude.FilePath -> Bool
 notHidden "tmp" = False

yesod/Yesod.hs

@@ -67,12 +67,12 @@ readIntegral s =
 
 -- | A convenience method to run an application using the Warp webserver on the
 -- specified port. Automatically calls 'toWaiApp'.
-warp :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
+warp :: YesodDispatch site => Int -> site -> IO ()
 warp port a = toWaiApp a >>= run port
 
 -- | Same as 'warp', but also sends a message to stdout for each request, and
 -- an \"application launched\" message as well. Can be useful for development.
-warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
+warpDebug :: YesodDispatch site => Int -> site -> IO ()
 warpDebug port app = do
   hPutStrLn stderr $ "Application launched, listening on port " ++ show port
   waiApp <- toWaiApp app
@@ -85,7 +85,7 @@ warpDebug port app = do
 -- Note that the exact behavior of this function may be modified slightly over
 -- time to work correctly with external tools, without a change to the type
 -- signature.
-warpEnv :: (Yesod a, YesodDispatch a a) => a -> IO ()
+warpEnv :: YesodDispatch site => site -> IO ()
 warpEnv master = do
     port <- getEnv "PORT" >>= readIO
     app <- toWaiApp master

yesod/Yesod/Default/Handlers.hs

@@ -4,11 +4,10 @@ module Yesod.Default.Handlers
     , getRobotsR
     ) where
 
-import Yesod.Handler (GHandler, sendFile)
-import Yesod.Content (RepPlain(..))
+import Yesod.Core
 
-getFaviconR :: GHandler s m ()
+getFaviconR :: HandlerError m => m ()
 getFaviconR = sendFile "image/x-icon" "config/favicon.ico"
 
-getRobotsR :: GHandler s m RepPlain
+getRobotsR :: HandlerError m => m ()
 getRobotsR = sendFile "text/plain" "config/robots.txt"

yesod/Yesod/Default/Util.hs

@@ -40,7 +40,7 @@ addStaticContentExternal
     -> Text -- ^ filename extension
     -> Text -- ^ mime type
     -> L.ByteString -- ^ file contents
-    -> GHandler sub master (Maybe (Either Text (Route master, [(Text, Text)])))
+    -> GHandler master (Maybe (Either Text (Route master, [(Text, Text)])))
 addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
     liftIO $ createDirectoryIfMissing True statictmp
     exists <- liftIO $ doesFileExist fn'