Master/Sub bikeshedding

Yesod/Hamlet.hs

@@ -45,7 +45,7 @@ data PageContent url = PageContent
 -- Yesod 'Response'.
 hamletToContent :: Hamlet (Routes master) IO () -> GHandler sub master Content
 hamletToContent h = do
-    render <- getUrlRenderMaster
+    render <- getUrlRender
     return $ ContentEnum $ go render
   where
     go render iter seed = do

Yesod/Handler.hs

@@ -26,20 +26,23 @@ module Yesod.Handler
     , GHandler
       -- ** Read information from handler
     , getYesod
-    , getYesodMaster
+    , getYesodSub
     , getUrlRender
-    , getUrlRenderMaster
     , getRoute
     , getRouteToMaster
       -- * Special responses
+      -- ** Redirecting
     , RedirectType (..)
     , redirect
+    , redirectParams
     , redirectString
-    , sendFile
+      -- ** Errors
     , notFound
     , badMethod
     , permissionDenied
     , invalidArgs
+      -- ** Sending static files
+    , sendFile
       -- * Setting headers
     , addCookie
     , deleteCookie
@@ -59,6 +62,7 @@ import Yesod.Internal
 import Web.Mime
 import Web.Routes.Quasi (Routes)
 import Data.List (foldl')
+import Web.Encodings (encodeUrlPairs)
 
 import Control.Exception hiding (Handler, catch)
 import qualified Control.Exception as E
@@ -153,23 +157,17 @@ instance RequestReader (GHandler sub master) where
 getData :: GHandler sub master (HandlerData sub master)
 getData = Handler $ \r -> return ([], [], HCContent r)
 
--- | Get the application argument.
-getYesod :: GHandler sub master sub
-getYesod = handlerSub <$> getData
+-- | Get the sub application argument.
+getYesodSub :: GHandler sub master sub
+getYesodSub = handlerSub <$> getData
 
 -- | Get the master site appliation argument.
-getYesodMaster :: GHandler sub master master
-getYesodMaster = handlerMaster <$> getData
+getYesod :: GHandler sub master master
+getYesod = handlerMaster <$> getData
 
 -- | Get the URL rendering function.
-getUrlRender :: GHandler sub master (Routes sub -> String)
-getUrlRender = do
-    d <- getData
-    return $ handlerRender d . handlerToMaster d
-
--- | Get the URL rendering function for the master site.
-getUrlRenderMaster :: GHandler sub master (Routes master -> String)
-getUrlRenderMaster = handlerRender <$> getData
+getUrlRender :: GHandler sub master (Routes master -> String)
+getUrlRender = handlerRender <$> getData
 
 -- | 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'.
@@ -243,9 +241,16 @@ safeEh er = YesodApp $ \_ _ _ -> do
 -- | Redirect to the given route.
 redirect :: RedirectType -> Routes master -> GHandler sub master a
 redirect rt url = do
-    r <- getUrlRenderMaster
+    r <- getUrlRender
     redirectString rt $ r url
 
+-- | Redirects to the given route with the associated query-string parameters.
+redirectParams :: RedirectType -> Routes master -> [(String, String)]
+               -> GHandler sub master a
+redirectParams rt url params = do
+    r <- getUrlRender
+    redirectString rt $ r url ++ '?' : encodeUrlPairs params
+
 -- | Redirect to the given URL.
 redirectString :: RedirectType -> String -> GHandler sub master a
 redirectString rt url = Handler $ \_ -> return ([], [], HCRedirect rt url)

Yesod/Helpers/Auth.hs

@@ -108,11 +108,12 @@ getOpenIdForward = do
             [x] -> return x
             _ -> invalidArgs [("openid", show ExpectedSingleParam)]
     render <- getUrlRender
-    let complete = render OpenIdComplete
+    toMaster <- getRouteToMaster
+    let complete = render $ toMaster OpenIdComplete
     res <- runAttemptT $ OpenId.getForwardUrl oid complete
-    let errurl err = render OpenIdR ++ "?message=" ++ encodeUrl (show err)
     attempt
-      (\err -> redirectString RedirectTemporary $ errurl err)
+      (\err -> redirectParams RedirectTemporary (toMaster OpenIdR)
+                [("message", show err)])
       (redirectString RedirectTemporary)
       res
 
@@ -121,19 +122,20 @@ getOpenIdComplete = do
     rr <- getRequest
     let gets' = reqGetParams rr
     res <- runAttemptT $ OpenId.authenticate gets'
-    render <- getUrlRender
-    renderm <- getUrlRenderMaster
+    renderm <- getUrlRender
+    toMaster <- getRouteToMaster
+    let render = renderm . toMaster
     let errurl err = render OpenIdR ++ "?message=" ++ encodeUrl (show err)
     let onFailure err = redirectString RedirectTemporary $ errurl err
     let onSuccess (OpenId.Identifier ident) = do
-        y <- getYesodMaster
+        y <- getYesod
         setSession identKey ident
         redirectToDest RedirectTemporary $ renderm $ defaultDest y
     attempt onFailure onSuccess res
 
 handleRpxnowR :: YesodAuth master => GHandler Auth master ()
 handleRpxnowR = do
-    ay <- getYesodMaster
+    ay <- getYesod
     apiKey <- case rpxnowApiKey ay of
                 Just x -> return x
                 Nothing -> notFound
@@ -142,11 +144,11 @@ handleRpxnowR = do
     let token = case getParams rr "token" ++ pp "token" of
                     [] -> failure MissingToken
                     (x:_) -> x
-    render <- getUrlRenderMaster
+    renderm <- getUrlRender
     let dest = case pp "dest" of
                 [] -> case getParams rr "dest" of
-                        [] -> render $ defaultDest ay
-                        ("":_) -> render $ defaultDest ay
+                        [] -> renderm $ defaultDest ay
+                        ("":_) -> renderm $ defaultDest ay
                         (('#':rest):_) -> rest
                         (s:_) -> s
                 (d:_) -> d
@@ -189,9 +191,9 @@ getCheck = do
 
 getLogout :: YesodAuth master => GHandler Auth master ()
 getLogout = do
-    y <- getYesodMaster
+    y <- getYesod
     clearSession identKey
-    render <- getUrlRenderMaster
+    render <- getUrlRender
     redirectToDest RedirectTemporary $ render $ defaultDest y
 
 -- | Gets the identifier for a user if available.
@@ -215,7 +217,7 @@ authIdentifier = maybeIdentifier >>= maybe redirectLogin return
 -- appropriately.
 redirectLogin :: YesodAuth master => GHandler sub master a
 redirectLogin = do
-    y <- getYesodMaster
+    y <- getYesod
     let r = case defaultLoginType y of
                 OpenId -> OpenIdR
                 Rpxnow -> RpxnowR -- FIXME this doesn't actually show a login page?
@@ -228,9 +230,10 @@ redirectSetDest :: RedirectType
                 -> GHandler sub master a
 redirectSetDest rt dest = do
     ur <- getUrlRender
+    tm <- getRouteToMaster
     curr <- getRoute
     let curr' = case curr of
-                    Just x -> ur x
+                    Just x -> ur $ tm x
                     Nothing -> "/" -- should never happen anyway
     addCookie destCookieTimeout destCookieName curr'
     redirect rt dest

Yesod/Helpers/EmailAuth.hs

@@ -80,7 +80,7 @@ getRegisterR = do
 postRegisterR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml
 postRegisterR = do
     email <- runFormPost $ checkEmail $ required $ input "email"
-    y <- getYesodMaster
+    y <- getYesod
     creds <- liftIO $ getCreds y email
     (lid, verKey) <-
         case creds of
@@ -90,7 +90,8 @@ postRegisterR = do
                 return (lid, key)
             Just (lid, _, _, key) -> return (lid, key)
     render <- getUrlRender
-    let verUrl = render $ VerifyR lid verKey
+    tm <- getRouteToMaster
+    let verUrl = render $ tm $ VerifyR lid verKey
     liftIO $ sendVerifyEmail y email verKey verUrl
     applyLayout "Confirmation e-mail sent" $ [$hamlet|
 %p A confirmation e-mail has been sent to $cs.email$.
@@ -102,7 +103,7 @@ checkEmail = notEmpty -- FIXME
 getVerifyR :: YesodEmailAuth master
            => Integer -> String -> GHandler EmailAuth master RepHtml
 getVerifyR lid key = do
-    y <- getYesodMaster
+    y <- getYesod
     realKey <- liftIO $ getVerifyKey y lid
     memail <- liftIO $ getEmail y lid
     case (realKey == Just key, memail) of
@@ -157,7 +158,7 @@ postLoginR = do
     (email, pass) <- runFormPost $ (,)
         <$> checkEmail (required $ input "email")
         <*> required (input "password")
-    y <- getYesodMaster
+    y <- getYesod
     creds <- liftIO $ getCreds y email
     let mlid =
             case creds of
@@ -216,7 +217,7 @@ postPasswordR = do
                 setMessage "You must be logged in to set a password"
                 redirect RedirectTemporary $ toMaster LoginR
     salted <- liftIO $ saltPass new
-    y <- getYesodMaster
+    y <- getYesod
     liftIO $ setPassword y lid salted
     setMessage "Password updated"
     redirect RedirectTemporary $ toMaster LoginR
@@ -226,7 +227,7 @@ getLogoutR = do
     clearSession identKey
     clearSession displayNameKey
     clearSession emailAuthIdKey
-    y <- getYesodMaster
+    y <- getYesod
     redirect RedirectTemporary $ onSuccessfulLogout y
 
 saltLength :: Int
@@ -257,7 +258,7 @@ setLoginSession email lid = do
     setSession identKey email
     setSession displayNameKey email
     setSession emailAuthIdKey $ show lid
-    y <- getYesodMaster
+    y <- getYesod
     liftIO $ onEmailAuthLogin y email lid
 
 isLoggedIn :: GHandler sub master (Maybe Integer)

Yesod/Helpers/Sitemap.hs

@@ -67,5 +67,5 @@ sitemap = fmap RepXml . hamletToContent . template
 robots :: Routes sub -- ^ sitemap url
        -> GHandler sub master RepPlain
 robots smurl = do
-    r <- getUrlRender
-    return $ RepPlain $ cs $ "Sitemap: " ++ r smurl
+    tm <- getRouteToMaster
+    RepPlain `fmap` hamletToContent [$hamlet|Sitemap: @tm.smurl@|]

Yesod/Helpers/Static.hs

@@ -77,7 +77,7 @@ getStatic fl fp' = do
 
 getStaticRoute :: [String] -> GHandler Static master [(ContentType, Content)]
 getStaticRoute fp = do
-    Static fl <- getYesod
+    Static fl <- getYesodSub
     getStatic fl fp
 
 toStaticRoute :: [String] -> StaticRoutes