Commits

Luke Plant committed 38d2fc5

Display comments at bottom of post

  • Participants
  • Parent commits 742b823

Comments (0)

Files changed (3)

src/Blog/Model.hs

                   , getPostBySlug
                   , getRecentPosts
                   , getCategoriesForPost
+                  , getCommentsForPost
                   ) where
 
 import Database.HDBC
 
 getCategoriesForPostQuery = "SELECT categories.id, categories.name, categories.slug FROM categories INNER JOIN post_categories ON categories.id = post_categories.category_id WHERE post_categories.post_id = ? ORDER BY categories.slug;"
 
+getCommentByIdQuery      = "SELECT id, post_id, timestamp, name, email, text_raw, text_formatted, format_id FROM comments WHERE id = ?;"
+getCommentsForPostQuery  = "SELECT id, '',      timestamp, name, email, '',       text_formatted, ''        FROM comments WHERE post_id = ? ORDER BY timestamp ASC;"
 
 ---- Constructors ----
 
                 , Ct.slug = fromSql (row !! 2)
                 }
 
+makeComment row =
+    Cm.Comment { Cm.uid = fromSql (row !! 0)
+               , Cm.post_id = fromSql (row !! 1)
+               , Cm.timestamp = fromSql (row !! 2)
+               , Cm.name = fromSql (row !! 3)
+               , Cm.email = fromSql (row !! 4)
+               , Cm.text_raw = fromSql (row !! 5)
+               , Cm.text_formatted = fromSql (row !! 6)
+               , Cm.format_id = fromSql (row !! 7)
+               }
+
 ---- Public API for queries ----
 
 getPostBySlug cn slug = do
 getCategoriesForPost cn post = do
   res <- quickQuery' cn getCategoriesForPostQuery [toSql $ P.uid post]
   return $ map makeCategory res
+
+getCommentsForPost cn post = do
+  res <- quickQuery' cn getCommentsForPostQuery [toSql $ P.uid post]
+  return $ map makeComment res

src/Blog/Templates.hs

 import Text.XHtml
 import qualified Blog.Post as P
 import qualified Blog.Category as C
+import qualified Blog.Comment as Cm
 import System.Locale (defaultTimeLocale)
 import System.Time.Utils (epochToClockTime)
 import System.Time (toUTCTime, formatCalendarTime)
                  , ptitle = "Categories"
                  }
 
-postPage post categories =
+postPage post categories comments =
     page $ defaultPageVars
-             { pcontent = formatPost post categories
+             { pcontent = formatPost post categories comments
              , ptitle = P.title post
              }
 
     )
 
 
-formatPost post categories =
+formatPost post categories comments =
     (h1 ! [theclass "posttitle"] << P.title post
      +++
      metaInfoLine post categories "metainfo"
      (thediv ! [theclass "post"]
       << (primHtml $ P.post_formatted post)
      )
+     +++
+     (thediv ! [theclass "comments"]
+      << (h1 << "Comments:")
+             +++ if null comments
+                 then p << "No comments."
+                 else thediv << map formatComment comments
+     )
     )
 
+formatComment comment =
+    (thediv ! [theclass "comment"] <<
+     ((thediv ! [theclass "commentby"] << formatName (Cm.name comment))
+      +++
+      (thediv ! [theclass "commenttext"]
+       << (primHtml $ Cm.text_formatted comment))
+     )
+    )
+
+formatName name = if null name
+                  then "Anonymous Coward"
+                  else name
 
 custom404page = page $ defaultPageVars { pcontent = h1 << "404 Not Found"
                                                     +++

src/Blog/Views.hs

 import Blog.Templates
 import Blog.Links
 import Blog.DB (connect)
-import Blog.Model (getPostBySlug, getCategoriesForPost, getRecentPosts)
+import Blog.Model (getPostBySlug, getCategoriesForPost, getRecentPosts, getCommentsForPost)
 
 standardResponse html = buildResponse [
                          addHtml html
     Nothing -> return $ Just $ custom404 -- preferred to 'Nothing'
     Just post -> do
             cats <- getCategoriesForPost cn post
-            return $ Just $ standardResponse $ postPage post cats
+            comments <- getCommentsForPost cn post
+            return $ Just $ standardResponse $ postPage post cats comments
 
 aboutView = dummyView