Commits

Luke Plant committed 2d5d221

Added basic view for showing single post, plus fixed some settings.

  • Participants
  • Parent commits 01f2f75

Comments (0)

Files changed (4)

                              [toSql $ fst pc,
                               toSql $ snd pc];
                              return pc; }
+
+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]
+  case res of
+    [] -> return Nothing
+    (postdata:_) -> return $ Just $ makePost postdata
+
+makePost row =
+    Post { uid = fromSql (row !! 0)
+         , title = fromSql (row !! 1)
+         , slug = fromSql (row !! 2)
+         , post_raw = fromSql (row !! 3)
+         , post_formatted = fromSql (row !! 4)
+         , summary_raw = fromSql (row !! 5)
+         , summary_formatted = fromSql (row !! 6)
+         , format_id = fromSql (row !! 7)
+         , timestamp = fromSql (row !! 8)
+         , comments_open = fromSql (row !! 9)
+         }

src/Blog/Templates.hs

 
 import Blog.Links
 import Text.XHtml
+import qualified Blog.Post as P
+import qualified Blog.Category as C
 
 
 -- | Holds variables for the 'page' template
 -- Page specific templates
 
 mainIndexPage = page $ defaultPageVars
-                { pcontent = h1 << "This is the title"
+                { pcontent = h1 << "Recent posts"
                              +++
                              p << "This is a test"
-                , ptitle = "This is the title"
+                , ptitle = ""
                 }
 
 categoriesPage = page $ defaultPageVars
                               p << "TODO"
                  , ptitle = "Categories"
                  }
+
+postPage post =
+    page $ defaultPageVars
+             { pcontent = formatPost post
+             , ptitle = P.title post
+             }
+
+formatPost post =
+    (h1 << P.title post
+     +++
+     (thediv ! [theclass "post"]
+      << (primHtml $ P.post_formatted post)
+     )
+    )

src/Blog/Views.hs

 {-# OPTIONS_GHC -fglasgow-exts -XOverloadedStrings #-}
 module Blog.Views where
 
+import Ella.Framework (default404)
 import Ella.Request
 import Ella.Response
 import Ella.Utils (addHtml)
 import Ella.GenUtils (utf8)
 import Blog.Templates
 import Blog.Links
+import Blog.DB (connect)
+import Blog.Post (getPostBySlug)
 
 standardResponse html = buildResponse [
                          addHtml html
 
 categoriesView req = return $ Just $ standardResponse categoriesPage :: IO (Maybe Response)
 categoryView slug = dummyView
-postView slug = dummyView
 
+postView slug req = do
+  cn <- connect
+  mp <- getPostBySlug cn slug
+  case mp of
+    Nothing -> return $ Just $ default404 -- preferred to 'Nothing'
+    Just post -> return $ Just $ standardResponse $ postPage post

src/Blog/settingslocal.hs

 -- Migration time settings:
 
 old_data_path = "/home/luke/httpd/lukeplant.me.uk/web/blog/data/"
-redirect_file_template = "/home/luke/devel/haskell/haskellblog/src/blog.php.tpl"
-redirect_file_output = "/home/luke/devel/haskell/haskellblog/src/blog.php"
+redirect_file_template = "/home/luke/devel/haskell/blog/src/blog.php.tpl"
+redirect_file_output = "/home/luke/devel/haskell/blog/src/blog.php"