From d817d37c9cbc0eeb097149d657a604ce176a1570 Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Wed, 8 Jan 2014 14:35:13 -0800
Subject: [PATCH] yesod-auth: user defined layout

---
 yesod-auth/Yesod/Auth.hs       | 19 ++++++++++++++++---
 yesod-auth/Yesod/Auth/Email.hs | 10 +++++-----
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 503443b5..0fb6dedc 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -91,6 +91,10 @@ data Creds master = Creds
 class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage) => YesodAuth master where
     type AuthId master
 
+    -- | specify the layout. Uses defaultLayout by default
+    authLayout :: WidgetT master IO () -> HandlerT master IO Html
+    authLayout = defaultLayout
+
     -- | Default destination on successful login, if no other
     -- destination exists.
     loginDest :: master -> Route master
@@ -109,7 +113,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     loginHandler :: AuthHandler master RepHtml
     loginHandler = do
         tp <- getRouteToParent
-        lift $ defaultLayout $ do
+        lift $ authLayout $ do
             setTitleI Msg.LoginTitle
             master <- getYesod
             mapM_ (flip apLogin tp) (authPlugins master)
@@ -273,7 +277,7 @@ setCreds doRedirects creds = do
                 Nothing -> do
                     sendResponseStatus unauthorized401 =<< (
                       selectRep $ do
-                        provideRep $ defaultLayout $ toWidget [shamlet|<h1>Invalid login|]
+                        provideRep $ authLayout $ toWidget [shamlet|<h1>Invalid login|]
                         provideJsonMessage "Invalid Login"
                       )
                 Just ar -> loginErrorMessageMasterI ar Msg.InvalidLogin
@@ -288,6 +292,15 @@ setCreds doRedirects creds = do
                   provideJsonMessage "Login Successful"
               sendResponse res
 
+-- | same as defaultLayoutJson, but uses authLayout
+authLayoutJson :: (YesodAuth site, ToJSON j)
+                  => WidgetT site IO ()  -- ^ HTML
+                  -> HandlerT site IO j  -- ^ JSON
+                  -> HandlerT site IO TypedContent
+authLayoutJson w json = selectRep $ do
+    provideRep $ authLayout w
+    provideRep $ fmap toJSON json
+
 -- | Clears current user credentials for the session.
 --
 -- Since 1.1.7
@@ -304,7 +317,7 @@ clearCreds doRedirects = do
 getCheckR :: AuthHandler master TypedContent
 getCheckR = lift $ do
     creds <- maybeAuthId
-    defaultLayoutJson (do
+    authLayoutJson (do
         setTitle "Authentication Status"
         toWidget $ html' creds) (return $ jsonCreds creds)
   where
diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs
index 9cdb3061..7270119f 100644
--- a/yesod-auth/Yesod/Auth/Email.hs
+++ b/yesod-auth/Yesod/Auth/Email.hs
@@ -168,7 +168,7 @@ class (YesodAuth site, PathPiece (AuthEmailId site)) => YesodAuthEmail site wher
     --
     -- Since 1.2.2
     confirmationEmailSentResponse :: Text -> HandlerT site IO Html
-    confirmationEmailSentResponse identifier = defaultLayout $ do
+    confirmationEmailSentResponse identifier = authLayout $ do
         setTitleI Msg.ConfirmationEmailSentTitle
         [whamlet|<p>_{Msg.ConfirmationEmailSent identifier}|]
 
@@ -221,7 +221,7 @@ getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
 getRegisterR = do
     email <- newIdent
     tp <- getRouteToParent
-    lift $ defaultLayout $ do
+    lift $ authLayout $ do
         setTitleI Msg.RegisterLong
         [whamlet|
             <p>_{Msg.EnterEmail}
@@ -275,7 +275,7 @@ getForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO
 getForgotPasswordR = do
     tp <- getRouteToParent
     email <- newIdent
-    lift $ defaultLayout $ do
+    lift $ authLayout $ do
         setTitleI Msg.PasswordResetTitle
         [whamlet|
             <p>_{Msg.PasswordResetPrompt}
@@ -307,7 +307,7 @@ getVerifyR lid key = do
                     lift $ setLoginLinkKey uid
                     redirect setpassR
         _ -> return ()
-    lift $ defaultLayout $ do
+    lift $ authLayout $ do
         setTitleI Msg.InvalidKey
         [whamlet|
 $newline never
@@ -358,7 +358,7 @@ getPasswordR = do
         Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
     tp <- getRouteToParent
     needOld <- maybe (return True) (lift . needOldPassword) maid
-    lift $ defaultLayout $ do
+    lift $ authLayout $ do
         setTitleI Msg.SetPassTitle
         [whamlet|
 $newline never