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 "" @@ -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