Commits

Luke Plant committed 64de167

Re-implemented index view using HStringTemplate

Comments (0)

Files changed (4)

src/Blog/Formats.hs

+{-# LANGUAGE DeriveDataTypeable #-}
 module Blog.Formats ( Format(..)
                     , getFormatter
                     )
 import Blog.Utils (regexReplace, regexReplaceCustom, regexReplaceS)
 import Control.Arrow ((>>>))
 import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.Data
 import Data.Maybe (fromJust)
+import Data.Typeable
 import Ella.GenUtils (utf8)
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.ByteString.Lazy.UTF8 as UTF8
 data Format = Rawhtml
             | Plaintext
             | RST
-            deriving (Eq, Ord, Show, Read, Enum)
+            deriving (Eq, Ord, Show, Read, Enum, Data, Typeable)
 
 
 formatRawhtml :: String -> String
+{-# LANGUAGE DeriveDataTypeable #-}
 module Blog.Post where
 
 import Blog.Formats (Format)
+import Data.Data
+import Data.Typeable
 
 data Post = Post {
       uid :: Int,
       format :: Format,
       timestamp :: Int,
       comments_open :: Bool
-    } deriving (Show, Eq)
-
+    } deriving (Show, Eq, Data, Typeable)

src/Blog/Templates.hs

 import Data.List (intersperse)
 import Data.Maybe (fromJust)
 import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy.Char8 (pack)
 import Ella.Forms.Base
 import Ella.Forms.Widgets (makeLabel)
 import System.Locale (defaultTimeLocale)
 import System.Time.Utils (epochToClockTime)
 import Text.XHtml
 import Text.StringTemplate
+import Text.StringTemplate.Classes (SElem(..))
 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
 --
 postLink p = toHtml $ hotlink (postUrl p) << (P.title p)
 
 showDate timestamp = formatCalendarTime defaultTimeLocale  "%e %B %Y" (toUTCTime $ epochToClockTime timestamp)
+
+
+-- HStringTemplate related:
+
+-- Allow for heterogeneous lists
+data ToSElemD = forall a. ToSElem a => ToSElemD a
+
+instance ToSElem ToSElemD where
+    toSElem (ToSElemD x) = toSElem x
+
+-- Allow Html to be inserted
+instance ToSElem Html where
+    toSElem x = BS (pack $ showHtmlFragment x)
+
+postTemplateInfo :: P.Post -> Map.Map String ToSElemD
+postTemplateInfo p = Map.fromList [ ("title", ToSElemD $ P.title p)
+                                  , ("date", ToSElemD $ showDate $ P.timestamp p)
+                                  , ("summary", ToSElemD $ pack $ P.summary_formatted p)
+                                  , ("full", ToSElemD $ pack $ P.post_formatted p)
+                                  , ("url", ToSElemD $ postUrl p)
+                                  ]
+
+categoryTemplateInfo :: C.Category -> Map.Map String ToSElemD
+categoryTemplateInfo c = Map.fromList [ ("name", ToSElemD $ C.name c)
+                                      , ("url", ToSElemD $ categoryUrl c)
+                                      ]

src/Blog/Views.hs

   cn <- connect
   (posts,more) <- getRecentPosts cn curpage
   cats <- getCategoriesBulk cn posts
-  return $ Just $ standardResponse $ mainIndexPage (zip posts cats) curpage more
-
+  t <- get_template "index"
+  return $ Just $ standardResponseBS $ (renderf t
+             ("posts", map postTemplateInfo posts)
+             ("categories", map (map categoryTemplateInfo) cats)
+             ("paginglinks", pagingLinks indexUrl curpage more)
+                                       )
 -- | View to help with debugging
 debug :: String -> View
 debug path req = return $ Just $ buildResponse [