Add querying/rendering of our blog posts

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")
         ]