Changed defaultTemplateAttribs; bumped text
This commit is contained in:
parent
3a3d970476
commit
28c5d2ab55
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user