diff --git a/Data/Object/Html.hs b/Data/Object/Html.hs
index 0e1dc616..0b03716f 100644
--- a/Data/Object/Html.hs
+++ b/Data/Object/Html.hs
@@ -32,6 +32,7 @@ import Data.Generics
import Data.Object.Text
import Data.Object.Json
import qualified Data.Text.Lazy as TL
+import Data.ByteString.Lazy (ByteString)
import Web.Encodings
import Text.StringTemplate.Classes
import Control.Arrow (second)
@@ -48,7 +49,7 @@ import Text.StringTemplate
data Html =
Html Text -- ^ Already encoded HTML.
| Text Text -- ^ Text which should be HTML escaped.
- | Tag String [(String, String)] [Html] -- ^ Tag which needs a closing tag.
+ | Tag String [(String, String)] Html -- ^ Tag which needs a closing tag.
| EmptyTag String [(String, String)] -- ^ Tag without a closing tag.
| HtmlList [Html]
deriving (Eq, Show, Typeable)
@@ -92,7 +93,7 @@ instance ConvertSuccess Html Text where
, cs n
, showAttribs as
, cs ">"
- , TL.concat $ map convertSuccess content
+ , cs content
, cs ""
, cs n
, cs ">"
@@ -107,6 +108,8 @@ instance ConvertSuccess Html Text where
instance ConvertSuccess Html String where
convertSuccess = cs . (cs :: Html -> Text)
+instance ConvertSuccess Html ByteString where
+ convertSuccess = cs . (cs :: Html -> Text)
instance ConvertSuccess Html HtmlDoc where
convertSuccess h = HtmlDoc $ TL.concat
@@ -118,13 +121,14 @@ instance ConvertSuccess Html HtmlDoc where
instance ConvertSuccess HtmlObject Html where
convertSuccess (Scalar h) = h
- convertSuccess (Sequence hs) = Tag "ul" [] $ map addLi hs where
- addLi h = Tag "li" [] [cs h]
+ convertSuccess (Sequence hs) = Tag "ul" [] $ HtmlList $ map addLi hs
+ where
+ addLi h = Tag "li" [] $ cs h
convertSuccess (Mapping pairs) =
- Tag "dl" [] $ concatMap addDtDd pairs where
+ Tag "dl" [] $ HtmlList $ concatMap addDtDd pairs where
addDtDd (k, v) =
- [ Tag "dt" [] [Text $ cs k]
- , Tag "dd" [] [cs v]
+ [ Tag "dt" [] $ Text $ cs k
+ , Tag "dd" [] $ cs v
]
instance ConvertSuccess HtmlObject HtmlDoc where
diff --git a/TODO b/TODO
index bb7148d8..394ef3dc 100644
--- a/TODO
+++ b/TODO
@@ -1,17 +1,9 @@
HTML sitemap generation
Cleanup Data.Object.Translate
-Remove Data.Object.Instances (Web.Types?)
-Possibly unify ResourceName and RestfulApp?
-Expand Yesod.Definitions?
Cleanup Parameter stuff. Own module? Interface with formlets?
-Merge MonadRequestReader class with other Handler stuff
-SitemapLoc: what's the point again?
Authentication via e-mail address built in. (eaut.org)
OpenID 2 stuff (for direct Google login).
-Simple model information (settings files, etc) in RestfulApp
Is there a mimetype package on hackage for Yesod.Helpers.Static?
-The RepT stuff is hideous.
-More than one type of objectResponse?
-Native support for HStringTemplate.
-Automatic HTML escaping, something smart for templates vs JSON.
-Handler should be a better type, do something about ToHandler.
+Native support for HStringTemplate groups.
+AtomFeed uses RelLoc and AbsLoc like Sitemap
+Fix type of sitemap
diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs
index c194faaf..ed93952d 100644
--- a/Yesod/Helpers/AtomFeed.hs
+++ b/Yesod/Helpers/AtomFeed.hs
@@ -19,8 +19,7 @@ module Yesod.Helpers.AtomFeed
, AtomFeedEntry (..)
) where
-import Yesod.Rep
-import Data.Convertible.Text
+import Yesod
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as TL
@@ -43,7 +42,7 @@ data AtomFeedEntry = AtomFeedEntry
{ atomEntryLink :: String
, atomEntryUpdated :: UTCTime
, atomEntryTitle :: String
- , atomEntryContent :: String
+ , atomEntryContent :: Html
}
instance ConvertSuccess AtomFeed Content where
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index 115264a9..5d964c43 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -64,7 +64,7 @@ instance Request OIDFormReq where
instance ConvertSuccess OIDFormReq Html where
convertSuccess (OIDFormReq Nothing _) = cs ""
convertSuccess (OIDFormReq (Just s) _) =
- Tag "p" [("class", "message")] [cs s]
+ Tag "p" [("class", "message")] $ cs s
authOpenidForm :: Handler y HtmlObject
authOpenidForm = do
@@ -72,8 +72,9 @@ authOpenidForm = do
let html =
HtmlList
[ cs m
- , Tag "form" [("method", "get"), ("action", "forward/")]
- [ Tag "label" [("for", "openid")] [cs "OpenID: "]
+ , Tag "form" [("method", "get"), ("action", "forward/")] $
+ HtmlList
+ [ Tag "label" [("for", "openid")] $ cs "OpenID: "
, EmptyTag "input" [("type", "text"), ("id", "openid"),
("name", "openid")]
, EmptyTag "input" [("type", "submit"), ("value", "Login")]
@@ -82,7 +83,7 @@ authOpenidForm = do
case dest of
Just dest' -> addCookie 120 "DEST" dest'
Nothing -> return ()
- return $ toHtmlObject $ Html $ cs html
+ return $ cs html
authOpenidForward :: Handler y HtmlObject
authOpenidForward = do
diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs
index b59686ea..9c4eb487 100644
--- a/Yesod/Rep.hs
+++ b/Yesod/Rep.hs
@@ -109,6 +109,8 @@ instance ConvertSuccess ByteString Content where
convertSuccess = Content
instance ConvertSuccess String Content where
convertSuccess = Content . cs
+instance ConvertSuccess Html Content where
+ convertSuccess = Content . cs
type ContentPair = (ContentType, Content)
type RepChooser = [ContentType] -> IO ContentPair