Changes to HTML type; AtomFeed and Auth

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
+    convertSuccess (Sequence hs) = Tag "ul" [] $ HtmlList $ map addLi hs
-        addLi h = Tag "li" [] [cs h]
+      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 "dt" [] $ Text $ cs k
-                , Tag "dd" [] [cs v]
+                , Tag "dd" [] $ cs v
                 ]
 
 instance ConvertSuccess HtmlObject HtmlDoc where

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.
+Native support for HStringTemplate groups.
-More than one type of objectResponse?
+AtomFeed uses RelLoc and AbsLoc like Sitemap
-Native support for HStringTemplate.
+Fix type of sitemap
-Automatic HTML escaping, something smart for templates vs JSON.
-Handler should be a better type, do something about ToHandler.

Yesod/Helpers/AtomFeed.hs

@@ -19,8 +19,7 @@ module Yesod.Helpers.AtomFeed
     , AtomFeedEntry (..)
     ) where
 
-import Yesod.Rep
+import Yesod
-import Data.Convertible.Text
 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

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 "form" [("method", "get"), ("action", "forward/")] $
-                [ Tag "label" [("for", "openid")] [cs "OpenID: "]
+              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

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