Commits

Luke Plant committed 7b2c8c8

Added showing of categories on main page.

Comments (0)

Files changed (3)

src/Blog/Model.hs

                   , getCategoriesForPost
                   , getCommentsForPost
                   , getRelatedPosts
+                  , getCategoriesBulk
                   ) where
 
 import Database.HDBC
 getRelatedPostsQuery ids = "SELECT id, title, slug, '',       '',             '',          '',                '',               '', ''            FROM posts INNER JOIN (SELECT post_id, COUNT(post_id) AS c from post_categories WHERE category_id IN " ++ sqlInIds ids ++ " GROUP BY post_id) as t2 ON posts.id = t2.post_id AND posts.id <> ? ORDER BY c DESC, abs(posts.timestamp - ?) ASC $LIMITOFFSET;"
 
 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;"
+getCategoriesBulkQuery ids= "SELECT categories.id, categories.name, categories.slug, post_categories.post_id FROM categories INNER JOIN post_categories ON categories.id = post_categories.category_id WHERE post_categories.post_id IN " ++ sqlInIds ids ++ " 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 ----
 
 makePost row =
   res <- quickQuery' cn getCommentsForPostQuery [toSql $ P.uid post]
   return $ map makeComment res
 
+-- | Gets the categories for a list of posts.  Results are returned
+-- as a list of list of categories
+getCategoriesBulk :: (IConnection conn) =>
+                     conn                  -- ^ connection
+                  -> [P.Post]              -- ^ list of posts
+                  -> IO [[Ct.Category]]
+getCategoriesBulk cn posts = do
+  let ids = map (P.uid) posts
+  res <- quickQuery' cn (getCategoriesBulkQuery ids) []
+  -- Create (Category, post id) pairs:
+  let cats = map (\r -> (makeCategory r, (fromSql $ r !! 3) :: Int)) res
+  -- split them up according to ids
+  return [ [ cat | (cat, pid) <- cats, P.uid p == pid ] | p <- posts]
+
+
 getRelatedPosts :: (IConnection conn) =>
                    conn -> P.Post -> [Ct.Category] -> IO [P.Post]
 getRelatedPosts cn post categories = do

src/Blog/Templates.hs

 
 -- Page specific templates
 
-mainIndexPage :: [P.Post]      -- ^ list of posts to display
-              -> Int           -- ^ current page number being displayed
-              -> Bool          -- ^ True if there are more pages to display
+mainIndexPage :: [(P.Post, [C.Category])] -- ^ list of posts (wtth their categories) to display
+              -> Int                      -- ^ current page number being displayed
+              -> Bool                     -- ^ True if there are more pages to display
               -> Html
-mainIndexPage posts curpage moreposts =
+mainIndexPage postInfo curpage moreposts =
     page $ defaultPageVars
-             { pcontent = formatIndex posts curpage moreposts
+             { pcontent = formatIndex postInfo curpage moreposts
              , ptitle = ""
              }
 
-formatIndex :: [P.Post] -> Int -> Bool -> Html
-formatIndex posts page shownext =
+formatIndex :: [(P.Post, [C.Category])] -> Int -> Bool -> Html
+formatIndex postInfo page shownext =
     (h1 << "Recent posts")
     +++
-    (do post <- posts
+    (do (post, cats) <- postInfo
         return (
                 (thediv ! [ theclass "summarylink" ]
                  << postLink post)
                 +++
+                (metaInfoLine post cats "metainfoindex")
+                +++
                 (thediv ! [ theclass "summary" ]
                  << (primHtml $ P.summary_formatted post))
                )

src/Blog/Views.hs

 import Blog.Templates
 import Blog.Links
 import Blog.DB (connect)
-import Blog.Model (getPostBySlug, getCategoriesForPost, getRecentPosts, getCommentsForPost, getRelatedPosts)
+import Blog.Model
 import Maybe (fromMaybe)
 
 ---- Utilities
   let page = (getGET "p" req) `captureOrDefault` 1 :: Int
   cn <- connect
   (posts,more) <- getRecentPosts cn page
-  return $ Just $ standardResponse $ mainIndexPage posts page more
+  cats <- getCategoriesBulk cn posts
+  return $ Just $ standardResponse $ mainIndexPage (zip posts cats) page more
 
 -- View to help with debugging
 debug path req = return $ Just $ buildResponse [