Changed defaultTemplateAttribs; bumped text

This commit is contained in:
Michael Snoyman 2010-02-04 08:10:07 +02:00
parent 3a3d970476
commit 28c5d2ab55
3 changed files with 9 additions and 5 deletions

View File

@ -223,7 +223,7 @@ authLogout = do
-- | Gets the identifier for a user if available.
maybeIdentifier :: (Functor m, Monad m, RequestReader m) => m (Maybe String)
maybeIdentifier = do
rr <- getRawRequest
rr <- getRawRequest -- FIXME provide version outside of monad?
return $ fmap cs $ lookup (B8.pack authCookieName) $ rawSession rr
-- | Gets the display name for a user if available.

View File

@ -22,13 +22,15 @@ import Yesod.Response
import Yesod.Yesod
import Yesod.Handler
import Control.Monad (join)
import Yesod.Request (RawRequest, getRawRequest)
type Template = StringTemplate Text
type TemplateGroup = STGroup Text
class Yesod y => YesodTemplate y where
getTemplateGroup :: y -> TemplateGroup
defaultTemplateAttribs :: y -> HtmlTemplate -> IO HtmlTemplate
defaultTemplateAttribs :: y -> RawRequest -> HtmlTemplate
-> IO HtmlTemplate
getTemplateGroup' :: YesodTemplate y => Handler y TemplateGroup
getTemplateGroup' = getTemplateGroup `fmap` getYesod
@ -54,11 +56,12 @@ templateHtml tn f = do
t <- case getStringTemplate tn tg of
Nothing -> failure $ NoSuchTemplate tn
Just x -> return x
rr <- getRawRequest
return $ RepHtml $ ioTextToContent
$ fmap (render . unHtmlTemplate)
$ join
$ fmap f
$ defaultTemplateAttribs y
$ defaultTemplateAttribs y rr
$ HtmlTemplate t
setHtmlAttrib :: ConvertSuccess x HtmlObject
@ -76,6 +79,7 @@ templateHtmlJson :: YesodTemplate y
templateHtmlJson tn ho f = do
tg <- getTemplateGroup'
y <- getYesod
rr <- getRawRequest
t <- case getStringTemplate tn tg of
Nothing -> failure $ NoSuchTemplate tn
Just x -> return x
@ -84,7 +88,7 @@ templateHtmlJson tn ho f = do
$ fmap (render . unHtmlTemplate)
$ join
$ fmap (f ho)
$ defaultTemplateAttribs y
$ defaultTemplateAttribs y rr
$ HtmlTemplate t
)
(hoToJsonContent ho)

View File

@ -45,7 +45,7 @@ library
transformers >= 0.1.4.0 && < 0.2,
control-monad-attempt >= 0.0.0 && < 0.1,
syb,
text >= 0.5 && < 0.6,
text >= 0.5 && < 0.8,
convertible-text >= 0.2.0 && < 0.3,
HStringTemplate >= 0.6.2 && < 0.7,
data-object-json >= 0.0.0 && < 0.1,