defaultTemplateAttribs

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

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)

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" "<DEFAULT>"
 instance Yesod HelloWorld where
     resources = [$mkResources|
 /:

examples/real-template.st

@@ -1,2 +1,3 @@
 This is a more realistic template.
 foo: $foo$
+This is the default argument: $default$