Commits

Luke Plant committed 2c3e9aa

Beginnings of index page

  • Participants
  • Parent commits 720add2

Comments (0)

Files changed (3)

File src/Blog/Post.hs

                               toSql $ snd pc];
                              return pc; }
 
+
+-- We optimise queries by removing items that are not actually used and replacing them with ''
+-- (we can then use the same 'makePost' function)
+getPostByIdQuery        = "SELECT id, title, slug, post_raw, post_formatted, summary_raw, summary_formatted, format_id, timestamp, comments_open FROM posts WHERE id = ?;"
+getPostBySlugQuery      = "SELECT id, title, slug, '',       post_formatted, '',          '',                '',        timestamp, comments_open FROM posts WHERE slug = ?;"
+getRecentPostQueries    = "SELECT id, title, slug, '',       '',             '',          summary_formatted, '',        timestamp, ''            FROM posts ORDER BY timestamp DESC LIMIT 20;"
+
+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 = ?;"
+
 getPostBySlug cn slug = do
-  let qry = "SELECT id, title, slug, post_raw, post_formatted, summary_raw, summary_formatted, format_id, timestamp, comments_open FROM posts WHERE slug = ?;"
-  res <- quickQuery cn qry [toSql slug]
+  res <- quickQuery cn getPostBySlugQuery [toSql slug]
   case res of
     [] -> return Nothing
     (postdata:_) -> return $ Just $ makePost postdata
          , comments_open = fromSql (row !! 9)
          }
 
+getRecentPosts cn = do
+  res <- quickQuery cn getRecentPostQueries []
+  return $ map makePost res
+
 getCategoriesForPost cn post = do
-  let qry = "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 = ?;"
-  res <- quickQuery cn qry [toSql $ uid post]
+  res <- quickQuery cn getCategoriesForPostQuery [toSql $ uid post]
   return $ map C.makeCategory res

File src/Blog/Templates.hs

 
 -- Page specific templates
 
-mainIndexPage = page $ defaultPageVars
-                { pcontent = h1 << "Recent posts"
-                             +++
-                             p << "This is a test"
-                , ptitle = ""
-                }
+mainIndexPage posts =
+    page $ defaultPageVars
+             { pcontent = h1 << "Recent posts"
+                          +++
+                          do post <- posts
+                             return (
+                                     (thediv ! [ theclass "summarylink" ]
+                                      << postLink post)
+                                     +++
+                                     (thediv ! [ theclass "summary" ]
+                                      << (primHtml $ P.summary_formatted post))
+                                    )
+             , ptitle = ""
+             }
 
 categoriesPage = page $ defaultPageVars
                  { pcontent = h1 << "Categories"
      (thediv ! [theclass "postcategories"]
       << ((toHtml "Categories: ")
           +++
-          (intersperse (toHtml ", ") $ map toHtml $ map categoryLink categories)))
+          (intersperse (toHtml ", ") $ map categoryLink categories)))
      +++
      (thediv ! [theclass "post"]
       << (primHtml $ P.post_formatted post)
 
 -- Utilities
 
-categoryLink c = hotlink (categoryUrl c) << (C.name c)
+categoryLink c = toHtml $ hotlink (categoryUrl c) << (C.name c)
+
+postLink p = toHtml $ hotlink (postUrl p) << (P.title p)
+
 
 showDate timestamp = formatCalendarTime defaultTimeLocale  "%Y-%m-%d" (toUTCTime $ epochToClockTime timestamp)

File src/Blog/Views.hs

 import Blog.Templates
 import Blog.Links
 import Blog.DB (connect)
-import Blog.Post (getPostBySlug, getCategoriesForPost)
+import Blog.Post (getPostBySlug, getCategoriesForPost, getRecentPosts)
 
 standardResponse html = buildResponse [
                          addHtml html
                         ] utf8HtmlResponse
 
 mainIndex :: Request -> IO (Maybe Response)
-mainIndex req = return $ Just $ standardResponse mainIndexPage
+mainIndex req = do
+  cn <- connect
+  posts <- getRecentPosts cn
+  return $ Just $ standardResponse $ mainIndexPage posts
 
 debug path req = return $ Just $ buildResponse [
                   addContent "Path:\n"