Moving on with Yesod and Docker

Last updated by Garry Cairns on 31 July 2016 12:18


In part two we got ready to build a blog. Our database-driven website needs to have models in the database to be of much use. Yesod makes this fantastically easy. But I want to write content for the site using markdown so it would be nice to be able to store that directly in our database and have the site render it appropriately.

Open the stack.yaml file in your and edit the extra-deps section to look like this:

extra-deps:
    - markdown-0.1.14
    - yesod-text-markdown-0.1.8

You need to edit two more files before you can build. Open Model.hs in your site directory and add the following lines (the first two should already be there):

import ClassyPrelude.Yesod
import Database.Persist.Quasi
import Text.Markdown (Markdown)
import Yesod.Text.Markdown()

Now open your_site_name.cabal in your site directory and add the following two lines to the long build-depends section, which is itself in the library section of the file.

, markdown
, yesod-text-markdown

Running stack build inside your site directory should now install the new libraries (I had to run it twice when I was writing this). stack exec -- yesod devel will bring your site up on localhost:3000 .

Building our site

We need a few things in place to start building a site users can interact with. They'll need to be able to reach your content and you'll need to be able to store and display it. We'll work through all these needs in turn.

Routes

Your site directory contains a file config/routes, which defines the URL patterns users will be able to visit. Yesod handles these really nicely and warns you when you define URL patterns that might mask each other. Those of you who've built large sites in a framework like Python's Django will appreciate that this removes a whole class of errors, which are often hard to debug.

We're making a blog so we'll want people to be able to read our posts. It will also be useful to have a page listing all of the posts. Open the routes file and add a couple of lines like this:

/blog/ BlogR GET POST
/blog/#BlogId ArticleR GET POST

I find these quite readable. You can see the information here delimited by spaces. First you have the route pattern (/blog/, /blog/#BlogId), followed by the handler that will respond to requests matching that route pattern (BlogR, ArticleR) and finally the http verbs that handler can process. Of course right now you'll have a problem compiling this because we haven't written the BlogR and ArticleR handlers yet and, even if we had, there's nowhere to store our posts.

Models for the database

If you're used to a framework like Django you'll be used to putting a lot on effort into defining class-based models that both map your code into a database representation and define behaviours for the objects being modeled. In Yesod, there's a clean separation between the database mapping and behaviours. Your site will already have a config/models file defining what will persist in our Postgres database. Open it and add the following:

Blog
    title Text sqltype=varchar(50)
    article Markdown
    posted UTCTime

Again, this is quite readable as space delimited data. You're asking to create a new database table, Blog, that will have the columns title, article and posted. The haskell types of these will be Text, Markdown and UTCTime respectively. We're additionally restricting the database type of our title field to accept a maximum of 50 characters. Yesod will then enforce this for us when we define forms.

Our first handlers

The scaffolded site that Yesod created for you defined some handlers. Spend some time reading them before we change them. If you have time make some changes yourself and compare what happens with what you expected to happen. Once you're happy to move on we'll get going.

Yesod will have created a Handler directory for your site. Create a file in it called Blog.hs. We'll write this one bit at a time and explain as we go. The first few lines should read like this:

module Handler.Blog where

import Import
import Yesod.Form.Bootstrap3
import Yesod.Text.Markdown

The first line declares the module Handler.Blog, which acts as a namespace for the rest of the code in the file. We then import the module's dependencies, including the markdown support we installed earlier. The import Import line brings in all the common code declared in your site's Import.hs file. I like to use that as a place to declare generally useful functions for my site, as you'll see shortly.

Next we're going to create a form we can use to create and change blog posts. Make the following declaration:

blogForm :: Maybe Blog -> AForm Handler Blog
blogForm mblog = Blog
                <$> areq textField (bfs ("Title" :: Text)) (blogTitle <$> mblog)
                <*> areq markdownField (bfs ("Article" :: Text)) (blogArticle <$> mblog)
                <*> lift (liftIO getCurrentTime)

The first line is a type signature indicating that our form will optionally take an instance of the Blog model we defined earlier and return a Yesod applicative form. The Maybe Blog part lets us use the same form regardless of whether we're creating or editing a blog post. If a Blog is present our form's field will be pre-filled with its content. If not the fields will be empty and we'll create the attributes and their associated Blog instance by completing and submitting the form.

The following lines set out how our form will populate the Blog it creates. <$> lifts a single argument function into a Functor. areq tells us that the form field we're defining is mandatory. Yesod will then enforce this in the browser by refusing any submissions with missing required fields. You can achieve the expected behaviour for an optional field with aopt. textField sets out what datatype the form is handling and it should tie up with how we defined the field in our model (see markdownField for contrast).

The two parts in parentheses are where all the magic happens. (bfs ("Title" :: Text)) will display an html text field, labelled "Title", to the user. It's important to note that :: Text is giving a type for the html input and not the data; that's why the following field has a Haskell type of markdownField but still a :: Text when defining the form input. (blogTitle <$> mblog) tells the form to evaluate whether an existing Blog was passed in and, if so, populate the field with the existing data in the title field in the database.

We can now add blog posts to the database but we need to be able to display them too. Add the following to the same handler file.

getBlogR :: Handler Html
getBlogR = do
    (widget, enctype) <- generateFormPost . renderBootstrap3 BootstrapBasicForm $ blogForm Nothing
    allPosts <- runDB $ selectList [] [Desc BlogId]
    currentPost <- runDB $ selectFirst [] [Desc BlogId]
    defaultLayout $ do
        setTitle "I blog when it works"
        addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.11.2/jquery.min.js"
        addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/8.5/highlight.min.js"
        addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.2.0/js/collapse.js"
        addStylesheetRemote "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/8.5/styles/zenburn.min.css"
        $(widgetFile "blog")

There's a lot going on there so we'll unpick it a bit. The type signature is simple enough. We're using do notation for the rest, which you can think of as letting you perform actions in order. Looking at getBlogR, we can see that we're packaging some values up --- see for example lines like allPosts <- ... --- but it's perhaps not clear where those values are going yet. We'll return to that.

The two lines that contain runDB are where we interact with our database. We're packaging up a list of blog posts in descending order into allPosts and the most recent post into currentPost (note the difference between selectList and selectFirst).

We then see a second block of do notation culminating in $(widgetFile "blog"). This whole block is where we build the page our readers will see. I'm going to assume the lines setting the title and adding references to remote scripts and stylesheets are easily interpreted. The $(widgetFile "blog") bit takes us to another group of files to edit called templates. We'll do that after we finish our blog handlers.

If you go all the way back up to our routes file you'll see we didn't say anything about a getBlogR; we said there'd be a BlogR and it would handle GET and POST operations. The getBlogR handler we just wrote is therefore only half the story. We also need a postBlogR one. Here it is.

postBlogR :: Handler Html
postBlogR = do
    ((res, widget), enctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ blogForm Nothing
    allPosts <- runDB $ selectList [] [Desc BlogId]
    currentPost <- runDB $ selectFirst [] [Desc BlogId]
    case res of
        FormSuccess blog -> do
            blogId <- runDB $ insert blog
            redirect $ ArticleR blogId
        _ -> defaultLayout $(widgetFile "blog")

That's very like our previous handler but notice the difference between the lines referring to the blog form. In getBlogR we're only rendering a form, which may or may not have pre-defined data. Here, we're running the form. The lines at the end first specify what to do in the event of the form succeeding. Again, Yesod does an excellent job of being readable and it's quite easy to see it inserts the blog in the database then redirects the user to the article page for that entry. The indentation shows that all other outcomes will return you to the original page. Yesod will handle giving the user appropriate error messages for the form.

The article handlers, to which our postBlogR handler referred are very similar.

getArticleR :: BlogId -> Handler Html
getArticleR blogId = do
    blog <- runDB $ get404 blogId
    (widget, enctype) <- generateFormPost . renderBootstrap3 BootstrapBasicForm $ blogForm (Just blog)
    defaultLayout $ do
        setTitle $ toHtml $ blogTitle blog
        addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/8.5/highlight.min.js"
        addStylesheetRemote "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/8.5/styles/zenburn.min.css"
        $(widgetFile "article")

postArticleR :: BlogId -> Handler Html
postArticleR blogId = do
    blog <- runDB $ get404 blogId
    ((res, widget), enctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ blogForm (Just blog)
    case res of
        FormSuccess updatedBlog -> do
            runDB . replace blogId $ updatedBlog
            redirect $ ArticleR blogId
        _ -> defaultLayout $(widgetFile "article")

The chief difference here is that they take a BlogId as an argument because they're designed to work on one post rather than a list. Similarly, they use the get404 function when interacting with the database, which returns a 404 page if it can't find an entry matching the ID supplied.

Finally, you'll need to register your new handler. Open Application.hs and add the line import Handler.Blog where you see the existing imports for handlers, then add Handler.Blog to the exposed-modules in the library section of your your_site.cabal file.

Templates

My main web development experience is with Python and Django. I've used both Django's templates and Jinja2. I find Yesod's template system nicer than either, primarily because of features such as type-safe URLs that help you avoid mistakes.

Yesod lets you template html, css and javascript easily and packages them together into widgets for you. The template system is well documented so I won't cover their features here, but will rather just point you at what needs edited to make your site. The important thing to note is that hamlet templates use indentation to determine which html block you're inside.

The primary template you'll want to edit is default-layout-wrapper.hamlet in the your_site/templates directory. Look for where the default file's <body> is and replace it with something like the following.

<body>
  <div class="container-fluid">
    <nav class="navbar">
      <a class="navbar-brand" href="/">ILikeWhenItWorks
      <ul class="nav navbar-nav pull-right">
        <li>
          <a href=@{BlogR}>Archive

  <div class="container-fluid">
    ^{pageBody pc}

    <footer>
      #{appCopyright $ appSettings master}

That will give you navigation and a footer on all your pages. See how the navigation link is pointing to our BlogR handler? The compiler will trace that all the way back to our routes file to create the URL for you.

You can see the footer pointing you to appSettings master to set a copyright notice, if you want one. That goes in your_site/config/settings.yml.

Now we can edit our blog and article templates. We want our blog page to show a list of articles, with perhaps the latest one published in full for convenience. The article pages will show one article on its own so we can link to them individually for our hordes of readers. The blog template might look like this:

<div class="col-md-12">
    <a class="btn btn-primary" role="button" data-toggle="collapse" href="#blogform" aria-expanded="false" aria-controls="collapseExample">Show form</a> 
<div class="col-md-12 collapse" id="blogform">
    <h3>Add an article
    <form method=post action=@{BlogR} enctype=#{enctype}>
        ^{widget}
        <button class="btn btn-success">Create post

<div class="row">

    <div class="col-md-8">
        $maybe article <- map entityVal currentPost
            <h2>#{blogTitle article}
            <p>
                <small>Last updated by site admin on #{formatDateStr $ blogPosted article}
            <hr />
            #{blogArticle article}
        $nothing
            <h2>No articles yet.
        <hr />

    <div class="col-md-4">
        $if null allPosts
            <h3>No posts yet.
        $else
            <h3>Previous posts
            $forall Entity id article <- allPosts
                <dl>
                    <dt>
                        <a href=@{ArticleR id}>#{blogTitle article}
                    <dd>
                        <small>Posted on #{formatDateStr $ blogPosted article}

Once again I give Yesod good marks for readability here. We'll go over some of the important stuff in more detail.

Styling

You'll notice I haven't said a word about styling your site. Yesod uses bootstrap 3 by default so you can get a very clean-looking site just by setting appropriate classes on your html. You can customize it if you don't want your site to look too generic.

Using items from the database

We now return to those lines in our handlers that looked like this:

allPosts <- runDB $ selectList [] [Desc BlogId]
currentPost <- runDB $ selectFirst [] [Desc BlogId]

You can see these entities are fed into our template in lines such as

$maybe article <- map entityVal currentPost

The $maybe construct lets us deal with the possibility that there aren't any articles yet. The indented hamlet code below it will run in the event that we find an article. The interpolated values, the ones that look like #{blogArticle article} fetch the relevant value from the Article column of the blog table in your database for the article ID assigned in the $maybe.

Note that the #{blogArticle article} value isn't contained inside any html tags. To quote from the Yesod book:

When you use variable interpolation in Hamlet (the HTML Shakespeare language), it automatically applies a toHtml call to the value inside.

So our markdown data will be converted to html without any intervention on our part.

Formatting dates

The only thing left to explain is the way I'm dealing with dates in the line

<small>Posted on #{formatDateStr $ blogPosted article}

I mentioned earlier I like to define generally useful functions in Import.hs. Add the following function to that file.

-- date formatting for templates
dateTimeFormat :: String
dateTimeFormat = "%e %B %Y %H:%M"

formatDateStr :: UTCTime -> String
formatDateStr = formatTime defaultTimeLocale dateTimeFormat
-- end date formatting

That lets us take the datetime stored in the database for our article and return a string suitable for displaying to users.

Our site now looks nice and lets us add, edit and view blog posts. But it also lets everyone else add, edit and view blog posts. On our site. We need authentication and authorization, so lets do that in the next part.