diff --git a/Data/Object/Html.hs b/Data/Object/Html.hs
index 7fa1e602..8ed6ff77 100644
--- a/Data/Object/Html.hs
+++ b/Data/Object/Html.hs
@@ -186,7 +186,7 @@ instance ToSElem HtmlObject where
#if TEST
caseHtmlToText :: Assertion
caseHtmlToText = do
- let actual = Tag "div" [("id", "foo"), ("class", "bar")]
+ let actual = Tag "div" [("id", "foo"), ("class", "bar")] $ HtmlList
[ Html $ cs "
Some HTML
"
, Text $ cs "<'this should be escaped'>"
, EmptyTag "img" [("src", "baz&")]
diff --git a/TODO b/TODO
index adda8355..e2c54485 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,4 @@
-Cleanup Data.Object.Translate
+Some form of i18n.
Cleanup Parameter stuff. Own module? Interface with formlets?
Authentication via e-mail address built in. (eaut.org)
OpenID 2 stuff (for direct Google login).
-Native support for HStringTemplate groups.
-Use Text for HStringTemplate throughout
diff --git a/Yesod.hs b/Yesod.hs
index 5e98a749..8f8fa700 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -21,7 +21,7 @@ module Yesod
, module Yesod.Resource
, module Data.Object.Html
, module Yesod.Rep
- , module Yesod.Templates
+ , module Yesod.Template
, module Data.Convertible.Text
, Application
) where
@@ -34,6 +34,6 @@ import Yesod.Handler
import Yesod.Resource
import Hack (Application)
import Yesod.Rep
-import Yesod.Templates
+import Yesod.Template
import Data.Object.Html
import Data.Convertible.Text
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index 2ba325a6..882e3cb1 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -38,6 +38,7 @@ module Yesod.Handler
import Yesod.Request
import Yesod.Response
import Yesod.Rep
+import Yesod.Template
import Control.Exception hiding (Handler)
import Control.Applicative
@@ -49,11 +50,10 @@ import Control.Monad (liftM, ap)
import System.IO
import Data.Object.Html
---import Data.Typeable
-
------ Handler monad
newtype Handler yesod a = Handler {
- unHandler :: (RawRequest, yesod) -> IO ([Header], HandlerContents a)
+ unHandler :: (RawRequest, yesod, TemplateGroup)
+ -> IO ([Header], HandlerContents a)
}
data HandlerContents a =
forall e. Exception e => HCError e
@@ -81,22 +81,26 @@ instance MonadIO (Handler yesod) where
instance Exception e => Failure e (Handler yesod) where
failure e = Handler $ \_ -> return ([], HCError e)
instance MonadRequestReader (Handler yesod) where
- askRawRequest = Handler $ \(rr, _) -> return ([], HCContent rr)
+ askRawRequest = Handler $ \(rr, _, _) -> return ([], HCContent rr)
invalidParam _pt pn pe = invalidArgs [(pn, pe)]
authRequired = permissionDenied
getYesod :: Handler yesod yesod
-getYesod = Handler $ \(_, yesod) -> return ([], HCContent yesod)
+getYesod = Handler $ \(_, yesod, _) -> return ([], HCContent yesod)
+
+instance HasTemplateGroup (Handler yesod) where
+ getTemplateGroup = Handler $ \(_, _, tg) -> return ([], HCContent tg)
runHandler :: Handler yesod RepChooser
-> (ErrorResult -> Handler yesod RepChooser)
-> RawRequest
-> yesod
+ -> TemplateGroup
-> [ContentType]
-> IO Response
-runHandler (Handler handler) eh rr y cts = do
+runHandler (Handler handler) eh rr y tg cts = do
(headers, contents) <- Control.Exception.catch
- (handler (rr, y))
+ (handler (rr, y, tg))
(\e -> return ([], HCError (e :: Control.Exception.SomeException)))
let contents' =
case contents of
@@ -105,7 +109,7 @@ runHandler (Handler handler) eh rr y cts = do
HCContent a -> Right a
case contents' of
Left e -> do
- Response _ hs ct c <- runHandler (eh e) specialEh rr y cts
+ Response _ hs ct c <- runHandler (eh e) specialEh rr y tg cts
let hs' = headers ++ hs ++ getHeaders e
return $ Response (getStatus e) hs' ct c
Right a -> do
diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs
index 84e42f6b..1b95523d 100644
--- a/Yesod/Rep.hs
+++ b/Yesod/Rep.hs
@@ -47,7 +47,6 @@ module Yesod.Rep
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Text.Lazy (Text)
-import qualified Data.Text.Lazy as TL
import Data.Maybe (mapMaybe)
import Data.Function (on)
@@ -162,15 +161,24 @@ instance HasReps Plain where
plain :: ConvertSuccess x Text => x -> Plain
plain = Plain . cs
-data Template = Template (StringTemplate Text) HtmlObject
+data Template = Template (StringTemplate Text)
+ String
+ HtmlObject
+ (IO [(String, HtmlObject)])
instance HasReps Template where
reps = [ (TypeHtml,
- \(Template t h) ->
- return $ cs $ render $ setAttribute "o" h t)
- , (TypeJson, \(Template _ ho) ->
+ \(Template t name ho attrsIO) -> do
+ attrs <- attrsIO
+ return
+ $ cs
+ $ render
+ $ setAttribute name ho
+ $ setManyAttrib attrs t)
+ , (TypeJson, \(Template _ _ ho _) ->
return $ cs $ unJsonDoc $ cs ho)
]
+-- FIXME
data TemplateFile = TemplateFile FilePath HtmlObject
instance HasReps TemplateFile where
reps = [ (TypeHtml,
@@ -231,7 +239,7 @@ caseChooseRepTemplate = do
ho = toHtmlObject [ ("foo", toHtmlObject "")
, ("bar", toHtmlObject ["bar1", "bar2"])
]
- hasreps = Template temp ho
+ hasreps = Template temp "o" ho $ return []
res1 = cs "foo:<fooval>, bar:bar1bar2"
res2 = cs $ "{\"bar\":[\"bar1\",\"bar2\"]," ++
"\"foo\":\"<fooval>\"}"
diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs
index 8e6e5f7c..81a5cf31 100644
--- a/Yesod/Resource.hs
+++ b/Yesod/Resource.hs
@@ -43,7 +43,7 @@ import Language.Haskell.TH.Ppr
import System.IO
-}
-import Data.Typeable (Typeable)
+import Data.Typeable
import Control.Exception (Exception)
import Data.Attempt -- for failure stuff
import Data.Object.Text
@@ -62,7 +62,6 @@ import Test.Framework.Providers.QuickCheck (testProperty)
import Test.HUnit hiding (Test)
import Test.QuickCheck
import Control.Monad (when)
-import Data.Typeable
#endif
resources :: QuasiQuoter
diff --git a/Yesod/Template.hs b/Yesod/Template.hs
new file mode 100644
index 00000000..84431566
--- /dev/null
+++ b/Yesod/Template.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Yesod.Template
+ ( HasTemplateGroup (..)
+ , template
+ , NoSuchTemplate
+ , TemplateGroup
+ ) where
+
+import Data.Object.Html
+import Data.Typeable (Typeable)
+import Control.Exception (Exception)
+import Control.Failure
+import Yesod.Rep
+import Data.Object.Text (Text)
+import Text.StringTemplate
+
+type TemplateGroup = STGroup Text
+
+class HasTemplateGroup a where
+ getTemplateGroup :: a TemplateGroup
+
+-- FIXME better home
+template :: (MonadFailure NoSuchTemplate t, HasTemplateGroup t)
+ => String -- ^ template name
+ -> String -- ^ object name
+ -> HtmlObject -- ^ object
+ -> IO [(String, HtmlObject)] -- ^ template attributes
+ -> t Template
+template tn on o attrs = do
+ tg <- getTemplateGroup
+ t <- case getStringTemplate tn tg of
+ Nothing -> failure $ NoSuchTemplate tn
+ Just x -> return x
+ return $ Template t on o attrs
+newtype NoSuchTemplate = NoSuchTemplate String
+ deriving (Show, Typeable)
+instance Exception NoSuchTemplate
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 83ae306f..294fb6db 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -16,6 +16,7 @@ import Yesod.Utils
import Data.Maybe (fromMaybe)
import Data.Convertible.Text
+import Text.StringTemplate
import qualified Hack
import Hack.Middleware.CleanPath
@@ -41,6 +42,10 @@ class Yesod a where
errorHandler :: ErrorResult -> Handler a RepChooser
errorHandler = defaultErrorHandler
+ -- | The template directory. Blank means no templates.
+ templateDir :: a -> FilePath
+ templateDir _ = ""
+
class Yesod a => YesodApproot a where
-- | An absolute URL to the root of the application.
approot :: a -> Approot
@@ -80,7 +85,12 @@ toHackApp' y env = do
verb = cs $ Hack.requestMethod env
handler = handlers resource verb
rr = cs env
- res <- runHandler handler errorHandler rr y types
+ -- FIXME don't do the templateDir thing for each request
+ let td = templateDir y
+ tg <- if null td
+ then return nullGroup
+ else directoryGroupRecursiveLazy td
+ res <- runHandler handler errorHandler rr y tg types
let langs = ["en"] -- FIXME
responseToHackResponse langs res
diff --git a/examples/hellotemplate.lhs b/examples/hellotemplate.lhs
index eed35ddd..69aa4a87 100644
--- a/examples/hellotemplate.lhs
+++ b/examples/hellotemplate.lhs
@@ -4,7 +4,7 @@
import Yesod
import Hack.Handler.SimpleServer
-data HelloWorld = HelloWorld TemplateGroup
+data HelloWorld = HelloWorld
instance Yesod HelloWorld where
handlers = [$resources|
/:
@@ -12,9 +12,7 @@ instance Yesod HelloWorld where
/groups:
Get: helloGroup
|]
-
-instance YesodTemplates HelloWorld where
- templates (HelloWorld g) = g
+ templateDir _ = "examples"
helloWorld :: Handler HelloWorld TemplateFile
helloWorld = return $ TemplateFile "examples/template.html" $ cs
@@ -22,11 +20,10 @@ helloWorld = return $ TemplateFile "examples/template.html" $ cs
, ("content", "Hey look!! I'm !")
]
-helloGroup = template "real-template" $ cs "foo"
+helloGroup = template "real-template" "foo" (cs "bar") $ return []
main :: IO ()
main = do
putStrLn "Running..."
- stg <- loadTemplates "examples"
- run 3000 (toHackApp $ HelloWorld stg)
+ run 3000 $ toHackApp HelloWorld
\end{code}
diff --git a/examples/real-template.st b/examples/real-template.st
index 4348e29e..5adaa77d 100644
--- a/examples/real-template.st
+++ b/examples/real-template.st
@@ -1 +1,2 @@
This is a more realistic template.
+foo: $foo$
diff --git a/test/quasi-resource.hs b/test/quasi-resource.hs
index c0f03e3a..03c0b88c 100644
--- a/test/quasi-resource.hs
+++ b/test/quasi-resource.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE QuasiQuotes #-}
import Yesod
+import Text.StringTemplate (nullGroup)
data MyYesod = MyYesod
@@ -54,7 +55,7 @@ ph h = do
rr = error "No raw request"
y = MyYesod
cts = [TypeHtml]
- res <- runHandler h eh rr y cts
+ res <- runHandler h eh rr y nullGroup cts
print res
main :: IO ()
diff --git a/yesod.cabal b/yesod.cabal
index 05820d8e..d0d71895 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -51,7 +51,8 @@ library
HStringTemplate >= 0.6.2 && < 0.7,
data-object-json >= 0.0.0 && < 0.1,
attempt >= 0.2.1 && < 0.3,
- template-haskell
+ template-haskell,
+ failure >= 0.0.0 && < 0.1
exposed-modules: Yesod
Yesod.Constants
Yesod.Rep
@@ -62,7 +63,7 @@ library
Yesod.Handler
Yesod.Resource
Yesod.Yesod
- Yesod.Templates
+ Yesod.Template
Data.Object.Html
Hack.Middleware.MethodOverride
Hack.Middleware.ClientSession