Migrating to Hakyll

Posted on August 3, 2013

I tend to generally prefer static content on the web when possible, so wordpress was a source of irritation for me for some time. After moving the site to a different hosting provider, I decided that it’s time for a cleanup. Hakyll seemed to tick the right checkboxes, and offered another opportunity to play with haskell.

After some fiddling with exitwp, I noticed this fork which addressed hackyll’s specific idiosyncrasy to the tag names containing underscore, and allowed to preserve the document tree structure that I had for my permalinks (it was my goal to preserve permalinks).

This is what I came up with by now:

--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import           Data.Monoid (mappend)
import           Hakyll


--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
    match "images/*" $ do
        route   idRoute
        compile copyFileCompiler

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

    match "about/index.markdown" $ do
        route   $ constRoute "about.html"
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/default.html" defaultContext
            >>= relativizeUrls

    match "posts/*/*/*/*" $ do
        route $ gsubRoute "posts/" (const "") `composeRoutes`
                gsubRoute ".markdown" (const "/index.html")
        compile $ pandocCompiler
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/post.html"    postCtx
            >>= loadAndApplyTemplate "templates/default.html" postCtx
            >>= relativizeUrls

    create ["archive.html"] $ do
        route idRoute
        compile $ do
            let archiveCtx =
                    field "posts" (\_ -> postList recentFirst) `mappend`
                    constField "title" "Archives"              `mappend`
                    defaultContext

            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
                >>= loadAndApplyTemplate "templates/default.html" archiveCtx
                >>= relativizeUrls
                >>= removeIndexHtml


    match "index.html" $ do
        route idRoute
        compile $ do
            let indexCtx = field "posts" $ \_ ->
                                postListCont $ fmap (take 3) . recentFirst

            getResourceBody
                >>= applyAsTemplate indexCtx
                >>= loadAndApplyTemplate "templates/default.html" postCtx
                >>= relativizeUrls
                >>= removeIndexHtml

    match "templates/*" $ compile templateCompiler

    create ["atom.xml"] $ do
    route idRoute
    compile $ do
        let feedCtx = postCtx `mappend` bodyField "description"
        posts <- feedList
        renderAtom myFeedConfiguration feedCtx posts

    create ["rss.xml"] $ do
    route idRoute
    compile $ do
        let feedCtx = postCtx `mappend` bodyField "description"
        posts <- feedList
        renderRss myFeedConfiguration feedCtx posts


--------------------------------------------------------------------------------
postCtx :: Context String
postCtx =
    dateField "date" "%B %e, %Y" `mappend`
    defaultContext


--------------------------------------------------------------------------------
postList :: ([Item String] -> Compiler [Item String]) -> Compiler String
postList sortFilter = do
    posts   <- sortFilter =<< loadAll "posts/*/*/*/*"
    itemTpl <- loadBody "templates/archive-item.html"
    list    <- applyTemplateList itemTpl postCtx posts
    return list

--------------------------------------------------------------------------------
postListCont :: ([Item String] -> Compiler [Item String]) -> Compiler String
postListCont sortFilter = do
    posts   <- sortFilter =<< loadAllSnapshots "posts/*/*/*/*" "content"
    itemTpl <- loadBody "templates/post-item.html"
    list    <- applyTemplateList itemTpl postCtx posts
    return list

--------------------------------------------------------------------------------
--feedList :: ([Item String] -> Compiler [Item String]) -> Compiler String
feedList = fmap (take 10) . recentFirst
    =<< loadAllSnapshots "posts/*/*/*/*" "content"

--------------------------------------------------------------------------------
removeIndexHtml :: Item String -> Compiler (Item String)
removeIndexHtml item = return $ fmap cuttail item
  where
    cuttail = withUrls $ replaceAll "/index.html" (const "/")


--------------------------------------------------------------------------------
myFeedConfiguration :: FeedConfiguration
myFeedConfiguration = FeedConfiguration
    { feedTitle       = "Average Blog"
    , feedDescription = "Random Ramblings"
    , feedAuthorName  = "Eugene Crosser"
    , feedAuthorEmail = "crosser@average.org"
    , feedRoot        = "http://www.average.org/blog/"
    }

There is a thing that I’ll need to address at some point: I’d prefer to keep the markdown source in a flat directory, and the posts be put in the tree based on the posting date. In the existing code, the route to the article is derived directly from the path to the markdown source.