On Style

once neglected, Haskellers are becoming more stylish

Posted on 2020-04-19

For me the style of a program has always been important — the better the arrangement, the easier to read. I try to adopt a style that communicate what code is doing from the layout.

Take the main function from this blog’s generator, which of course has been inspired by many other example blogs down the years (including my own). Jasper’s blog is laid out on the same principles so he gets the credit in my mind.

main :: IO ()
main = hakyllWith cfg $ do

    match (fromList ["favicon.ico","apple-touch-icon.png"]) $ do
        route   idRoute
        compile copyFileCompiler

    match (fromRegex "^assets/scss/[^_].*.scss") $ do
        route $ setExtension "css"
        compile $ fmap compressCss <$> sassCompilerWith sass_options

    match "assets/css/*" $ do
        route   idRoute
        compile compressCssCompiler

    match "assets/images/*" $ do
        route   idRoute
        compile copyFileCompiler

    match (fromList ["pages/about.md"]) $ do
        route   $ setExtension "html"
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/post.html"    postCtx
            >>= loadAndApplyTemplate "templates/default.html" postCtx
            >>= relativizeUrls

    match "posts/*" $ do
        route $ setExtension "html"
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/post.html"    postCtx
            >>= loadAndApplyTemplate "templates/default.html" postCtx
            >>= relativizeUrls

    create ["pages/extension-reviews.html"] $ do
        route     idRoute
        compile $ do
          let ctx = mconcat
                [ constField "title"               "Language Extension Reviews"
                , field      "extension-review-list"  extensionReviewList
                , defaultContext
                ]
          makeItem ""
              >>= loadAndApplyTemplate "templates/extension-reviews.html" ctx
              >>= loadAndApplyTemplate "templates/default.html"           ctx
              >>= relativizeUrls

    create ["pages/package-reviews.html"] $ do
        route     idRoute
        compile $ do
          let ctx = mconcat
                [ constField "title"                "Package Reviews"
                , field      "package-review-list"  packageReviewList
                , defaultContext
                ]
          makeItem ""
              >>= loadAndApplyTemplate "templates/package-reviews.html" ctx
              >>= loadAndApplyTemplate "templates/default.html"         ctx
              >>= relativizeUrls

    create ["pages/structure-reviews.html"] $ do
        route     idRoute
        compile $ do
          let ctx = mconcat
                [ constField "title"                  "Structure Reviews"
                , field      "structure-review-list"  structureReviewList
                , defaultContext
                ]
          makeItem ""
              >>= loadAndApplyTemplate "templates/structure-reviews.html" ctx
              >>= loadAndApplyTemplate "templates/default.html"           ctx
              >>= relativizeUrls

    create ["pages/archive.html"] $ do
        route idRoute
        compile $ do
            posts <- chronological =<< loadAll "posts/*"
            let ctx = mconcat
                  [ listField  "posts" postCtx $ pure posts
                  , constField "title" "Archives"
                  , defaultContext
                  ]
            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" ctx
                >>= loadAndApplyTemplate "templates/default.html" ctx
                >>= relativizeUrls

    create ["index.html"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll "posts/*"
            let ctx = mconcat
                  [ listField   "posts" postCtx (return posts)
                  , constField  "title"   "Home"
                  , constField  "heading" "Posts"
                  , defaultContext
                  ]
            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" ctx
                >>= loadAndApplyTemplate "templates/default.html" ctx
                >>= relativizeUrls

    match "templates/**" $ compile templateBodyCompiler

    create ["atom.xml"] $ do
        route idRoute
        compile $ do
            let feedCtx = postCtx <>
                    constField "description" "This is the post description"

            posts <- fmap (take 10) . recentFirst =<< loadAll "posts/*"
            renderAtom feedConfig feedCtx posts

    create ["rss.xml"] $ do
        route idRoute
        compile $ do
            let feedCtx = postCtx <>
                    constField "description" "This is the post description"

            posts <- fmap (take 10) . recentFirst =<< loadAll "posts/*"
            renderRss feedConfig feedCtx posts

In the bad old days I would expect to be greeted by a wall of text, with each stage compressed into as few characters as possible with no consideration given to layout as a means of explaining the intent of the code. I have seen non-Haskellers singing the praises of Hakyll with its pure Haskell DSL — and I doubt if that would have happened if the Hakyll blogs were poorly laid out.

Now of course, in commercial team contexts some people are strong advocates of running all code through maximally opinionated code formatters like ormolu and it is interesting to see what ormolu makes of our blog main function.

main :: IO ()
main = hakyllWith cfg $ do
  match (fromList ["favicon.ico", "apple-touch-icon.png"]) $ do
    route idRoute
    compile copyFileCompiler
  match (fromRegex "^assets/scss/[^_].*.scss") $ do
    route $ setExtension "css"
    compile $ fmap compressCss <$> sassCompilerWith sass_options
  match "assets/css/*" $ do
    route idRoute
    compile compressCssCompiler
  match "assets/images/*" $ do
    route idRoute
    compile copyFileCompiler
  match (fromList ["pages/about.md"]) $ do
    route $ setExtension "html"
    compile $
      pandocCompiler
        >>= loadAndApplyTemplate "templates/post.html" postCtx
        >>= loadAndApplyTemplate "templates/default.html" postCtx
        >>= relativizeUrls
  match "posts/*" $ do
    route $ setExtension "html"
    compile $
      pandocCompiler
        >>= loadAndApplyTemplate "templates/post.html" postCtx
        >>= loadAndApplyTemplate "templates/default.html" postCtx
        >>= relativizeUrls
  create ["pages/extension-reviews.html"] $ do
    route idRoute
    compile $ do
      let ctx =
            mconcat
              [ constField "title" "Language Extension Reviews",
                field "extension-review-list" extensionReviewList,
                defaultContext
              ]
      makeItem ""
        >>= loadAndApplyTemplate "templates/extension-reviews.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls
  create ["pages/package-reviews.html"] $ do
    route idRoute
    compile $ do
      let ctx =
            mconcat
              [ constField "title" "Package Reviews",
                field "package-review-list" packageReviewList,
                defaultContext
              ]
      makeItem ""
        >>= loadAndApplyTemplate "templates/package-reviews.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls
  create ["pages/structure-reviews.html"] $ do
    route idRoute
    compile $ do
      let ctx =
            mconcat
              [ constField "title" "Structure Reviews",
                field "structure-review-list" structureReviewList,
                defaultContext
              ]
      makeItem ""
        >>= loadAndApplyTemplate "templates/structure-reviews.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls
  create ["pages/archive.html"] $ do
    route idRoute
    compile $ do
      posts <- chronological =<< loadAll "posts/*"
      let ctx =
            mconcat
              [ listField "posts" postCtx $ pure posts,
                constField "title" "Archives",
                defaultContext
              ]
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls
  create ["index.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/*"
      let ctx =
            mconcat
              [ listField "posts" postCtx (return posts),
                constField "title" "Home",
                constField "heading" "Posts",
                defaultContext
              ]
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls
  match "templates/**" $ compile templateBodyCompiler
  create ["atom.xml"] $ do
    route idRoute
    compile $ do
      let feedCtx =
            postCtx
              <> constField "description" "This is the post description"
      posts <- fmap (take 10) . recentFirst =<< loadAll "posts/*"
      renderAtom feedConfig feedCtx posts
  create ["rss.xml"] $ do
    route idRoute
    compile $ do
      let feedCtx =
            postCtx
              <> constField "description" "This is the post description"
      posts <- fmap (take 10) . recentFirst =<< loadAll "posts/*"
      renderRss feedConfig feedCtx posts

I am impressed by how well it has done and I do see the value of such opinionated code formatters in large industrial projects but I think we should not stop here and keep iterating because reading code is such a critical activity in the whole software development lifecycle. We have seen major benefits of good modern layout over poor layout and I suspect there is more to come.

Points to note.

I am not sure that removing the empty lines has helped and would be tempted to leave that one with the coders.
There are some things that an algoritmic formatter is most unlikely to capture (like the alignment of the post contexts inside pipeline stages).
This particular example — the main function of a Hakyll blog — is one that is just so singular and critical to the (blog) enterprise that I would like the option of requesting that it should not be algorithmically formatted (at least until the formatters get really good) by dropping a pragma that tells the formatter to leave well alone.
There are some choices that have been reversed that I really do not like (I am not going to name them) and I think it would be wise of any lead engineer to allow local pragmatic hints where well-known variants are concerned. (Either that or adopt the correct conventions!)

Got an issue with any of this? Please share or drop me a line (see below).