Commits

Luke Plant committed ecd83e6

Reorganised routes and added some dummy view functions

  • Participants
  • Parent commits 61f6e9d

Comments (0)

Files changed (3)

File src/Blog/Routes.hs

 
 -- TODO - a better way of generating this, something like Routes
 
+-- * Routes
+
+indexRoute         = empty
+postRoute          = "posts/" <+/> stringParam
+categoriesRoute    = "categories/" <+/> empty
+categoryRoute      = "categories/" <+/> stringParam
+debugRoute         = "debug/" <+/> stringParam
+
+routes = [ indexRoute        //-> mainIndex
+         , postRoute         //-> postView
+         , categoriesRoute   //-> categoriesView
+         , categoryRoute     //-> categoryView
+         , debugRoute        //-> debug
+         ]
+
+
+-- * URL functions
+
+-- These provide handy wrappers for generating URLs from objects
+
 makePostUrl p = Settings.root_url ++ "posts/" ++ (P.slug p) ++ "/"
 makeCategoryUrl c = Settings.root_url ++ "categories/" ++ (C.slug c) ++ "/"
 
-routes = [ empty                       //-> mainIndex
-         , "debug/" <+/> stringParam   //-> debug
-         ]

File src/Blog/Templates.hs

 import Text.XHtml
 
 
-data PageVars t1 t2 = (HTML t1, HTML t2) => PageVars
+-- | Holds variables for the 'page' template
+--
+-- fields should be limited to type class HTML, but that makes record
+-- update syntax impossible with current GHC.
+data PageVars t1 t2 = {- (HTML t1, HTML t2) => -} PageVars
     { ptitle :: t1
     , pcontent :: t2
     }
 
+defaultPageVars = PageVars { ptitle = "All Unkept"
+                           , pcontent = ""
+                           }
+
 -- Complete page template
 page vars =
     header
 
 -- Page specific templates
 
-mainIndexPage = page $ PageVars
-                { ptitle = "All Unkept"
-                , pcontent = (thediv ! [identifier "maintitle"]
+mainIndexPage = page $ defaultPageVars
+                { pcontent = (thediv ! [identifier "maintitle"]
                               << thediv
                                      << "All Unkept"
                               +++

File src/Blog/Views.hs

 import Web.Utils
 import Blog.Templates
 
+standardResponse html = buildResponse [
+                         addHtml html
+                        ] utf8HtmlResponse
+
 mainIndex :: Request -> IO (Maybe Response)
-mainIndex req = return $ Just $ buildResponse [
-                 addHtml mainIndexPage
-                ] utf8HtmlResponse
+mainIndex req = return $ Just $ standardResponse mainIndexPage
 
 debug path req = return $ Just $ buildResponse [
                   addContent "Path:\n"
                  , addContent $ utf8 path
                  , addContent "\n\nRequest:\n"
                  , addContent $ utf8 $ show req
-                 ] utf8TextResponse 
+                 ] utf8TextResponse
+
+
+-- TODO
+
+dummyView req = return $ Just $ standardResponse ("TODO" :: String) :: IO (Maybe Response)
+
+categoriesView = dummyView
+categoryView slug = dummyView
+postView slug = dummyView