Add querying/rendering of our blog posts

Author: danpalmer

snaplets/heist/templates/blog_posts.tpl

@@ -0,0 +1,11 @@
+<apply template="base">
+  <h1>Blog Posts</h1>
+  <ul>
+    <blogPosts>
+      <li>
+        <strong><title/></strong>
+        <p><postContent/></p>
+      </li>
+    </blogPosts>
+  </ul>
+</apply>

src/Models.hs

@@ -10,13 +10,26 @@ module Models where
 
 import Data.Text
 import Data.Time.Clock
+import Control.Monad.IO.Class (MonadIO)
 
 import Database.Persist.TH
 import Snap.Snaplet.Auth.Backends.Persistent (authEntityDefs)
 
+import qualified Database.Esqueleto as E
+
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] $ authEntityDefs ++ [persistLowerCase|
   BlogPost
     title String
     content String
     deriving Eq Show
 |]
+
+selectBlogPosts :: MonadIO m => E.SqlPersistT m [BlogPost]
+selectBlogPosts = do
+    posts <-
+        E.select $
+        E.from $ \blogPost -> do
+            E.orderBy [E.asc (blogPost E.^. BlogPostTitle)]
+            E.limit 3
+            return blogPost
+    return $ E.entityVal <$> posts

src/Site.hs

@@ -63,12 +63,28 @@ handleNewUser = method GET handleForm <|> method POST handleFormSubmit
     handleFormSubmit = registerUser "login" "password" >> redirect "/"
 
 
+------------------------------------------------------------------------------
+-- | Handle the blog posts view when logged in
+handleBlogPosts :: Handler App (AuthManager App) ()
+handleBlogPosts = do
+  blogPosts <- runPersist selectBlogPosts
+  renderWithSplices "blog_posts" (splices blogPosts)
+  where
+    splices bps =
+      "blogPosts" ## I.mapSplices (I.runChildrenWith . splicesFromBlogPost) bps
+
+    splicesFromBlogPost p = do
+      "title" ## I.textSplice (T.pack (blogPostTitle p))
+      "postContent" ## I.textSplice (T.pack (blogPostContent p))
+
+
 ------------------------------------------------------------------------------
 -- | The application's routes.
 routes :: [(ByteString, Handler App App ())]
 routes = [ ("/login",    with auth handleLoginSubmit)
          , ("/logout",   with auth handleLogout)
          , ("/new_user", with auth handleNewUser)
+         , ("/posts",    with auth handleBlogPosts)
          , ("",          serveDirectory "static")
          ]