From 2067d5d687e61137a4664ca87116c749a0637dde Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 9 May 2010 14:30:24 +0300
Subject: [PATCH] Added head to applyLayout(Json)

---
 Yesod/Helpers/Auth.hs      |  4 ++--
 Yesod/Helpers/EmailAuth.hs | 10 +++++-----
 Yesod/Yesod.hs             | 12 +++++++-----
 3 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index 763201c5..65c5e1d7 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -92,7 +92,7 @@ getOpenIdR = do
         (x:_) -> addCookie destCookieTimeout destCookieName x
     rtom <- getRouteToMaster
     let message = cs <$> (listToMaybe $ getParams rr "message")
-    applyLayout "Log in via OpenID" $ [$hamlet|
+    applyLayout "Log in via OpenID" (return ()) [$hamlet|
 $maybe message msg
     %p.message $msg$
 %form!method=get!action=@rtom.OpenIdForward@
@@ -174,7 +174,7 @@ getCheck = do
     ident <- maybeIdentifier
     dn <- displayName
     let arg = (cs $ fromMaybe "" ident, cs $ fromMaybe "" dn)
-    applyLayoutJson "Authentication Status" arg html json
+    applyLayoutJson "Authentication Status" (return ()) arg html json
   where
     html (x, y) = [$hamlet|
 %h1 Authentication Status
diff --git a/Yesod/Helpers/EmailAuth.hs b/Yesod/Helpers/EmailAuth.hs
index 46c64066..dcbbde1c 100644
--- a/Yesod/Helpers/EmailAuth.hs
+++ b/Yesod/Helpers/EmailAuth.hs
@@ -69,7 +69,7 @@ mkYesodSub "EmailAuth" [''YesodEmailAuth] [$parseRoutes|
 getRegisterR :: Yesod master => GHandler EmailAuth master RepHtml
 getRegisterR = do
     toMaster <- getRouteToMaster
-    applyLayout "Register a new account" $ [$hamlet|
+    applyLayout "Register a new account" (return ()) [$hamlet|
 %p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
 %form!method=post!action=@toMaster.RegisterR@
     %label!for=email E-mail
@@ -93,7 +93,7 @@ postRegisterR = do
     tm <- getRouteToMaster
     let verUrl = render $ tm $ VerifyR lid verKey
     liftIO $ sendVerifyEmail y email verKey verUrl
-    applyLayout "Confirmation e-mail sent" $ [$hamlet|
+    applyLayout "Confirmation e-mail sent" (return ()) [$hamlet|
 %p A confirmation e-mail has been sent to $cs.email$.
 |]
 
@@ -112,7 +112,7 @@ getVerifyR lid key = do
             setLoginSession email lid
             toMaster <- getRouteToMaster
             redirect RedirectTemporary $ toMaster PasswordR
-        _ -> applyLayout "Invalid verification key" $ [$hamlet|
+        _ -> applyLayout "Invalid verification key" (return ()) [$hamlet|
 %p I'm sorry, but that was an invalid verification key.
         |]
 
@@ -132,7 +132,7 @@ getLoginR :: Yesod master => GHandler EmailAuth master RepHtml
 getLoginR = do
     toMaster <- getRouteToMaster
     msg <- getMessage
-    applyLayout "Login" $ [$hamlet|
+    applyLayout "Login" (return ()) [$hamlet|
 $maybe msg ms
     %p.message $ms$
 %p Please log in to your account.
@@ -182,7 +182,7 @@ getPasswordR = do
         setMessage "You must be logged in to set a password"
         redirect RedirectTemporary $ toMaster LoginR
     msg <- getMessage
-    applyLayout "Set password" [$hamlet|
+    applyLayout "Set password" (return ()) [$hamlet|
 $maybe msg ms
     %p.message $ms$
 %h3 Set a new password
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 9a62c8b6..8ec5587d 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -85,12 +85,13 @@ class YesodSite a => Yesod a where
 -- | Apply the default layout ('defaultLayout') to the given title and body.
 applyLayout :: Yesod master
             => String -- ^ title
+            -> Hamlet (Routes master) IO () -- ^ head
             -> Hamlet (Routes master) IO () -- ^ body
             -> GHandler sub master RepHtml
-applyLayout t b =
+applyLayout t h b =
     RepHtml `fmap` defaultLayout PageContent
                 { pageTitle = cs t
-                , pageHead = return ()
+                , pageHead = h
                 , pageBody = b
                 }
 
@@ -98,14 +99,15 @@ applyLayout t b =
 -- the default layout for the HTML output ('defaultLayout').
 applyLayoutJson :: Yesod master
                 => String -- ^ title
+                -> Hamlet (Routes master) IO () -- ^ head
                 -> x
                 -> (x -> Hamlet (Routes master) IO ())
                 -> (x -> Json (Routes master) ())
                 -> GHandler sub master RepHtmlJson
-applyLayoutJson t x toH toJ = do
+applyLayoutJson t h x toH toJ = do
     html <- defaultLayout PageContent
                 { pageTitle = cs t
-                , pageHead = return ()
+                , pageHead = h
                 , pageBody = toH x
                 }
     json <- jsonToContent $ toJ x
@@ -115,7 +117,7 @@ applyLayout' :: Yesod master
              => String -- ^ title
              -> Hamlet (Routes master) IO () -- ^ body
              -> GHandler sub master ChooseRep
-applyLayout' s = fmap chooseRep . applyLayout s
+applyLayout' s = fmap chooseRep . applyLayout s (return ())
 
 -- | The default error handler for 'errorHandler'.
 defaultErrorHandler :: Yesod y