Commits

Luke Plant committed 9f5848a

Reimplemented categories page using HStringTemplate

Comments (0)

Files changed (6)

         MissingH >= 1.0.2,
         pandoc >= 1.1,
         SHA >= 1.0.2,
+        HStringTemplate >= 0.5.1.3,
         ella >= 0.1.2
   Main-is: BlogCgi.hs
   hs-source-dirs: src
+{-# LANGUAGE DeriveDataTypeable #-}
 module Blog.Category where
 
+import Data.Typeable
+import Data.Data
 import Database.HDBC
 import Blog.DBUtils (makeSlugGeneric)
 import qualified Blog.DB as DB
 data Category = Category { uid :: Int,
                            name :: String,
                            slug :: String
-                         } deriving (Show, Eq)
+                         } deriving (Show, Eq, Data, Typeable)
 

src/Blog/Templates.hs

 import Blog.Links
 import Data.List (intersperse)
 import Data.Maybe (fromJust)
+import Data.ByteString.Lazy (ByteString)
 import Ella.Forms.Base
 import Ella.Forms.Widgets (makeLabel)
 import System.Locale (defaultTimeLocale)
 import System.Time (toUTCTime, formatCalendarTime)
 import System.Time.Utils (epochToClockTime)
 import Text.XHtml
+import Text.StringTemplate
 import qualified Blog.Category as C
 import qualified Blog.Comment as Cm
 import qualified Blog.Post as P
 import qualified Blog.Settings as Settings
 import qualified Data.Map as Map
+import qualified Data.ByteString.Lazy as BS
 
 -- | Holds variables for the 'page' template
 --
            pagingLinks url curpage shownext
           )
 
-categoriesPage :: [C.Category] -> Html
-categoriesPage cats =
-    page $ defaultPageVars
-             { pcontent = h1 << "Categories"
-                          +++
-                          (map formatCategoryLink cats)
-             , ptitle = "Categories"
-             }
-
 formatCategoryLink cat =
     (thediv ! [theclass "category"]
      << categoryLink cat)
-{-# OPTIONS_GHC -fglasgow-exts -XOverloadedStrings #-}
+{-# OPTIONS_GHC -fglasgow-exts #-}
 module Blog.Views where
 
 -- View functions and logic. The actual HTML is found in Templates,
 import Ella.Utils (addHtml)
 import Maybe (fromMaybe, isJust, fromJust)
 import System.Time (ClockTime(..), toUTCTime)
+import Text.StringTemplate
+import Text.StringTemplate.GenericStandard
+import Text.XHtml (stringToHtml)
 import qualified Blog.Settings as Settings
 import qualified Data.Map as Map
 
                          addHtml html
                         ] utf8HtmlResponse
 
+standardResponseBS content = buildResponse [
+                              addContent content
+                             ] utf8HtmlResponse
 
 -- | Custom 404 response
 custom404 :: Response
 -- | View to help with debugging
 debug :: String -> View
 debug path req = return $ Just $ buildResponse [
-                  addContent "Path:\n"
+                  addContent $ utf8 "Path:\n"
                  , addContent $ utf8 path
-                 , addContent "\n\nRequest:\n"
+                 , addContent $ utf8 "\n\nRequest:\n"
                  , addContent $ utf8 $ show req
                  ] utf8TextResponse
 
 categoriesView req = do
   cn <- connect
   cats <- getCategories cn
-  return $ Just $ standardResponse $ categoriesPage cats
+  templates' <- directoryGroup Settings.template_path
+  let templates = setEncoderGroup (show . stringToHtml) templates'
+  let t = fromJust $ getStringTemplate "categories" templates
+  let categories = [ (c, categoryUrl c) | c <- cats ]
+  return $ Just $ standardResponseBS $ render $ t `with` [ setAttribute "categories" categories
+                                                         , setAttribute "hasCategories" (not . null $ cats)
+
+                                                         ]
 
 -- | View that shows posts for an individual category
 categoryView :: String -> View

src/Blog/settingslocal.hs

 module Blog.Settings where
 
-sqlite_path = "/home/luke/httpd/lukeplant.me.uk/web/cgi-bin/data/test1.db"
+cgi_root_path = "/home/luke/httpd/lukeplant.me.uk/web/cgi-bin"
+sqlite_path = cgi_root_path ++ "/data/test1.db"
+template_path = cgi_root_path ++ "/data/blogtemplates/"
+
 root_url = "/blog/"
 prog_uri = "/cgi-bin/blog.cgi" -- Used for redirecting
 blog_author_name = "luke"

src/templates/categories.st

+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=utf-8"
+     /><link rel="alternate" type="application/rss+xml" title="RSS" href="/TODO"
+     /><link rel="StyleSheet" href="/newblog.css" type="text/css"
+     /><link rel="shortcut icon" href="/favicon.ico" type="image/x-icon"
+     /><!--[if lte IE 6]><link rel="stylesheet" href="/newblog_IE6.css" type="text/css" /><![endif]--><title
+    >Categories &#171; All Unkept</title
+    ></head
+  ><body
+  ><div id="container"
+    ><div id="toplinks"
+      ><ul
+	><li
+	  ><a href="/blog/" class="first"
+	    >Home</a
+	    ></li
+	  ><li
+	  ><a href="/blog/categories/"
+	    >Categories</a
+	    ></li
+	  ><li
+	  ><a href="/blog/feeds/"
+	    >Feeds</a
+	    ></li
+	  ><li
+	  ><a href="/blog/about/"
+	    >About</a
+	    ></li
+	  ></ul
+	></div
+      ><div id="maintitle"
+      ><div
+	>All Unkept</div
+	></div
+      ><div id="content"
+      ><div id="contentinner"
+	><h1
+	  >Categories</h1
+	  >$if(hasCategories)$
+          $categories:{ c |
+            <div class="category"
+   	    ><a href="$c.1$/"
+	    >$c.0.name$</a
+	    ></div>
+          }$
+          $else$
+          <p>No categories defined</p>
+          $endif$
+          <div class="category"
+	  ></div
+	></div
+      ><div id="footer"
+      ><h1
+	>Links</h1
+	><div class="bloglinks"
+	><h2
+	  >Blog links:</h2
+	  ><ul
+	  ><li
+	    ><a href="/blog/"
+	      >Index</a
+	      ></li
+	    ><li
+	    ><a href="/blog/feeds/"
+	      >Feeds</a
+	      ></li
+	    ><li
+	    ><a href="/blog/categories/"
+	      >Categories</a
+	      ></li
+	    ><li
+	    ><a href="/blog/about/"
+	      >About blog</a
+	      ></li
+	    ></ul
+	  ></div
+	><div class="sitelinks"
+	><h2
+	  >Also on this site:</h2
+	  ><ul
+	  ><li
+	    ><a href="/"
+	      >Index</a
+	      ></li
+	    ><li
+	    ><a href="/softprojects.html"
+	      >Software</a
+	      ></li
+	    ><li
+	    ><a href="/bibleverses/"
+	      >Bible memorisation</a
+	      ></li
+	    ><li
+	    ><a href="/personal.html"
+	      >About me</a
+	      ></li
+	    ></ul
+	  ></div
+	></div
+      ></div
+    ></body
+  ></html
+>