diff --git a/Yesod/Request.hs b/Yesod/Request.hs index b8331553..56b39925 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE PackageImports #-} --------------------------------------------------------- -- -- Module : Yesod.Request @@ -48,7 +49,7 @@ import Data.Convertible.Text import Control.Arrow ((***)) import Control.Exception (SomeException (..)) import Data.Maybe (fromMaybe) -import Control.Monad.Trans +import "transformers" Control.Monad.Trans import Control.Concurrent.MVar #if TEST diff --git a/Yesod/Template.hs b/Yesod/Template.hs index afb9fd48..0e364dca 100644 --- a/Yesod/Template.hs +++ b/Yesod/Template.hs @@ -21,13 +21,14 @@ import Text.StringTemplate import Yesod.Response import Yesod.Yesod import Yesod.Handler +import Control.Monad (join) type Template = StringTemplate Text type TemplateGroup = STGroup Text class Yesod y => YesodTemplate y where getTemplateGroup :: y -> TemplateGroup - -- FIXME defaultTemplateAttribs :: y -> HtmlTemplate -> Handler y HtmlTemplate + defaultTemplateAttribs :: y -> HtmlTemplate -> IO HtmlTemplate getTemplateGroup' :: YesodTemplate y => Handler y TemplateGroup getTemplateGroup' = getTemplateGroup `fmap` getYesod @@ -49,11 +50,16 @@ templateHtml :: YesodTemplate y -> Handler y RepHtml templateHtml tn f = do tg <- getTemplateGroup' + y <- getYesod t <- case getStringTemplate tn tg of Nothing -> failure $ NoSuchTemplate tn Just x -> return x - return $ RepHtml $ ioTextToContent $ fmap (render . unHtmlTemplate) - $ f $ HtmlTemplate t + return $ RepHtml $ ioTextToContent + $ fmap (render . unHtmlTemplate) + $ join + $ fmap f + $ defaultTemplateAttribs y + $ HtmlTemplate t setHtmlAttrib :: ConvertSuccess x HtmlObject => String -> x -> HtmlTemplate -> HtmlTemplate @@ -69,10 +75,16 @@ templateHtmlJson :: YesodTemplate y -> Handler y RepHtmlJson templateHtmlJson tn ho f = do tg <- getTemplateGroup' + y <- getYesod t <- case getStringTemplate tn tg of Nothing -> failure $ NoSuchTemplate tn Just x -> return x return $ RepHtmlJson - (ioTextToContent $ fmap (render . unHtmlTemplate) - $ f ho $ HtmlTemplate t) + ( ioTextToContent + $ fmap (render . unHtmlTemplate) + $ join + $ fmap (f ho) + $ defaultTemplateAttribs y + $ HtmlTemplate t + ) (hoToJsonContent ho) diff --git a/examples/hellotemplate.lhs b/examples/hellotemplate.lhs index 7e0d7f45..af1479fe 100644 --- a/examples/hellotemplate.lhs +++ b/examples/hellotemplate.lhs @@ -7,6 +7,7 @@ import Network.Wai.Handler.SimpleServer data HelloWorld = HelloWorld TemplateGroup instance YesodTemplate HelloWorld where getTemplateGroup (HelloWorld tg) = tg + defaultTemplateAttribs _ = return . setHtmlAttrib "default" "" instance Yesod HelloWorld where resources = [$mkResources| /: diff --git a/examples/real-template.st b/examples/real-template.st index 5adaa77d..17161eeb 100644 --- a/examples/real-template.st +++ b/examples/real-template.st @@ -1,2 +1,3 @@ This is a more realistic template. foo: $foo$ +This is the default argument: $default$