January 23, 2017

Housekeeping

The existence of this site seems to perpetuate itself. Started as proof (to myself, mostly) that I had finally managed to wrangle octopress into submission, the next milestone was the transition to jekyll, followed by last years transition to hakyll and now to a shell script of my own making. Sometimes the only words that surface here are another account of how those words got here, so it has become a self-propelling entity!

Why move on from hakyll? It’s more a move on from haskell, really, coupled with the fact that I can do without it now and use my own shell code. Haskell is a great idea, but I find its implementation a little uncomfortable. I found working with haskell’s ‘cabal’ and ‘stack’ tools to be arse-numbingly irritating, to the extent that I now consider the cabal to be a secretive network of academics who can get the damn thing to just install some stuff already. (And why does everything written in haskell seem to be so huge? Try installing the yi editor some time - vi-like, it is enormously bigger than the 298K of ex/vi that I’m writing this in.) Hakyll, on the other hand, was a pleasure to work with and Jasper, its creator, is endlessly patient with those who use it. And I’m still using pandoc for my markdown conversion, so there’s a wee bit of haskell around the place all the time. For the sake of posterity, here’s the final version of site.hs, which has now been replaced with site.sh.

{-# LANGUAGE OverloadedStrings #-}

import          Hakyll
import          Text.Pandoc
import          Data.Time
import          Data.Text (pack, unpack, replace, empty)
import          Data.List (isPrefixOf)

main :: IO ()
main = hakyll $ do

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

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

    match "files/*" $ do
        route $ gsubRoute "files/" (const "")
        compile copyFileCompiler

    match "posts/**/*" $ do
        route $ stripPostsDirRoute `composeRoutes` stripDateFromPostRoute
        compile $ pandocCompilerWith defaultHakyllReaderOptions myWriterOptions
            >>= externalizeUrls (feedRoot myFeedConfiguration)
            >>= saveSnapshot "content"
            >>= unExternalizeUrls (feedRoot myFeedConfiguration)
            >>= loadAndApplyTemplate "templates/post.html" postCtx

    match "index.html" $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll "posts/**/*"
            let indexCtx =
                    listField "posts" postCtx (return posts) `mappend`
                    defaultContext
            getResourceBody
                >>= applyAsTemplate indexCtx
                >>= loadAndApplyTemplate "templates/index.html" indexCtx

    create ["atom.xml"] $ do
        route idRoute
        compile $ do
            let feedCtx = postCtx `mappend` bodyField "description"
            posts <- fmap (take 10) . recentFirst =<<
                loadAllSnapshots "posts/**/*" "content"
            renderAtom myFeedConfiguration feedCtx posts

    create ["feed.rss"] $ do
        route idRoute
        compile $ do
            let feedCtx = postCtx `mappend` bodyField "description"
            posts <- fmap (take 10) . recentFirst =<<
                loadAllSnapshots "posts/**/*" "content"
            renderRss myFeedConfiguration feedCtx posts

    create ["sitemap.xml"] $ do
            route idRoute
            compile $ do
                posts <- recentFirst =<< loadAll "posts/**/*"
                let sitemapCtx =
                      listField "posts" sitemapModCtx (return posts)
                makeItem ""
                    >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx

    match "templates/*" $ compile templateCompiler

localModifiedTime :: Context a
localModifiedTime = field "modified" $ \i -> do
    modified    <- getItemModificationTime (itemIdentifier i)
    timeZone <- unsafeCompiler getCurrentTimeZone
    let localTime = utcToZonedTime timeZone modified
    return $ formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z" localTime

sitemapModCtx :: Context String
sitemapModCtx =
    localModifiedTime `mappend`
    defaultContext

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

myWriterOptions :: WriterOptions
myWriterOptions = defaultHakyllWriterOptions
    { writerHtml5 = True
    }

stripPostsDirRoute :: Routes
stripPostsDirRoute = gsubRoute "posts/" (const "") `composeRoutes` setExtension ".html"

stripDateFromPostRoute :: Routes
stripDateFromPostRoute = gsubRoute "/[0-9]{4}-[0-9]{2}-[0-9]{2}-" (const "/")

myFeedConfiguration :: FeedConfiguration
myFeedConfiguration = FeedConfiguration
    { feedTitle       = "Bark&amp;Log"
    , feedDescription = "Bark&amp;Log"
    , feedAuthorName  = "Larry Hynes"
    , feedAuthorEmail = "foo@bar.com"
    , feedRoot        = "http://larryhynes.net"
    }

externalizeUrls :: String -> Item String -> Compiler (Item String)
externalizeUrls root item = return $ fmap (externalizeUrlsWith root) item

externalizeUrlsWith :: String -> String -> String
externalizeUrlsWith root = withUrls ext
  where
    ext x = if isExternal x then x else root ++ x

unExternalizeUrls :: String -> Item String -> Compiler (Item String)
unExternalizeUrls root item = return $ fmap (unExternalizeUrlsWith root) item

unExternalizeUrlsWith :: String -> String -> String
unExternalizeUrlsWith root = withUrls unExt
  where
    unExt x = if root `isPrefixOf` x then unpack $ replace (pack root) empty (pack x) else x