applyLayout requires RawRequest

This commit is contained in:
Michael Snoyman 2010-02-11 21:20:40 +02:00
parent 784675919b
commit f94a3ea7e0

View File

@ -47,10 +47,11 @@ class Yesod a where
-- | Applies some form of layout to <title> and <body> contents of a page. -- | Applies some form of layout to <title> and <body> contents of a page.
applyLayout :: a applyLayout :: a
-> RawRequest
-> String -- ^ title -> String -- ^ title
-> Html -- ^ body -> Html -- ^ body
-> Content -> Content
applyLayout _ t b = cs (cs (Tag "title" [] $ cs t, b) :: HtmlDoc) applyLayout _ _ t b = cs (cs (Tag "title" [] $ cs t, b) :: HtmlDoc)
class Yesod a => YesodApproot a where class Yesod a => YesodApproot a where
-- | An absolute URL to the root of the application. -- | An absolute URL to the root of the application.
@ -63,8 +64,9 @@ applyLayout' :: Yesod y
-> Handler y ChooseRep -> Handler y ChooseRep
applyLayout' t b = do applyLayout' t b = do
y <- getYesod y <- getYesod
rr <- getRawRequest
return $ chooseRep return $ chooseRep
[ (TypeHtml, applyLayout y t b) [ (TypeHtml, applyLayout y rr t b)
] ]
-- | A convenience wrapper around 'applyLayout' which provides a JSON -- | A convenience wrapper around 'applyLayout' which provides a JSON
@ -75,8 +77,9 @@ applyLayoutJson :: Yesod y
-> Handler y ChooseRep -> Handler y ChooseRep
applyLayoutJson t b = do applyLayoutJson t b = do
y <- getYesod y <- getYesod
rr <- getRawRequest
return $ chooseRep return $ chooseRep
[ (TypeHtml, applyLayout y t $ cs b) [ (TypeHtml, applyLayout y rr t $ cs b)
, (TypeJson, cs $ unJsonDoc $ cs b) , (TypeJson, cs $ unJsonDoc $ cs b)
] ]