blag/site.hs

{-|
Module      : Main
Description : Static HTML generation for my blog
Copyright   : (c) 2019 Chris Hodapp
License     : ??
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE OverloadedStrings #-}
import           Data.Monoid (mappend)
import           Hakyll
import           System.FilePath
import           Text.Pandoc.Options
import qualified GHC.IO.Encoding as E
import qualified Data.Set as S

-- | Configuration for the RSS and ATOM feeds.
feedConfiguration :: FeedConfiguration
feedConfiguration = FeedConfiguration
    { feedTitle = "hodapple blog"
    , feedDescription = "FIXME!"
    , feedAuthorName = "Chris Hodapp"
    , feedAuthorEmail = "Hodapp87@gmail.com"
    , feedRoot = "http://???"
    }

-- | Alternate pandocCompiler which enables MathJax
pandocMathCompiler :: Compiler (Item String)
pandocMathCompiler =
  -- Lifted straight from:
  -- http://travis.athougies.net/posts/2013-08-13-using-math-on-your-hakyll-blog.html
  let mathExtensions = [ Ext_tex_math_dollars
                       , Ext_tex_math_double_backslash
                       , Ext_latex_macros]
      defaultExtensions = writerExtensions defaultHakyllWriterOptions
      newExtensions = foldr enableExtension defaultExtensions mathExtensions
      writerOptions = defaultHakyllWriterOptions {
        writerExtensions = newExtensions,
          writerHTMLMathMethod = MathJax ""
        }
  in pandocCompilerWith defaultHakyllReaderOptions writerOptions

-- | Main entry point for generating all code via Hakyll
main :: IO ()
main = do
  E.setLocaleEncoding E.utf8
  hakyll $ do
    -- Build up tags
    tags <- buildTags "posts/*" (fromCapture "tags/*.html")
    let postCtxTags = postCtxWithTags tags

    match ("images/**" .||. "assets/**" .||. "assets_external/**" .||. "css/*" .||. "js/**") $ do
        route   idRoute
        compile copyFileCompiler

    match "images/favicons/*" $ do
        route $ customRoute $ takeFileName . toFilePath
        compile copyFileCompiler

    match "pages/*" $ do
        route   $ setExtension "html"
        compile $ pandocMathCompiler
            >>= loadAndApplyTemplate "templates/default.html" defaultContext
            >>= relativizeUrls

    match "slides/**" $ version "raw" $ do
        route idRoute
        compile copyFileCompiler

    -- We want .lhs files to be directly accessible, so copy them
    -- through unmodified.
    match ("posts/*.lhs" .||. "drafts/*.lhs") $ version "raw" $ do
        route idRoute
        compile $ getResourceBody >>= relativizeUrls

    match "posts/*" $ do
        route $ setExtension "html"
        compile $ pandocMathCompiler
            >>= loadAndApplyTemplate "templates/post.html"     postCtxTags
            >>= saveSnapshot "feedContent"
            >>= loadAndApplyTemplate "templates/comments.html" postCtxTags
            >>= loadAndApplyTemplate "templates/default.html"  postCtxTags
            >>= relativizeUrls

    match "drafts/*" $ do
        route $ setExtension "html"
        compile $ pandocMathCompiler
            >>= loadAndApplyTemplate "templates/post.html"     postCtxTags
            >>= loadAndApplyTemplate "templates/default.html"  postCtxTags
            >>= relativizeUrls

    create ["archive.html"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll ("posts/*" .&&. hasNoVersion)
            let archiveCtx =
                    listField "posts" postCtxTags (return posts) `mappend`
                    constField "title" "Archives"                `mappend`
                    defaultContext

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

    match "index.html" $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll ("posts/*" .&&. hasNoVersion)
            let indexCtx =
                    listField "posts" postCtxTags (return posts) `mappend`
                    constField "title" "Home"                    `mappend`
                    defaultContext
                    -- so... "posts" is a list field which is added
                    -- into indexCtx with contents derived from
                    -- 'posts' above.

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

    match "templates/*" $ compile templateCompiler
                                  
    create ["atom.xml"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAllSnapshots ("posts/*" .&&. complement "posts/*.lhs") "feedContent"
            renderAtom feedConfiguration feedCtx posts

    create ["rss.xml"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAllSnapshots ("posts/*" .&&. complement "posts/*.lhs") "feedContent"
            renderRss feedConfiguration feedCtx posts

    tagsRules tags $ \tag pattern -> do
        let title = "Posts tagged \"" ++ tag ++ "\""
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll pattern
            let ctx = constField "title" title
                      `mappend` listField "posts" postCtx (return posts)
                      `mappend` defaultContext

            makeItem ""
                >>= loadAndApplyTemplate "templates/tag.html" ctx
                >>= loadAndApplyTemplate "templates/default.html" ctx
                >>= relativizeUrls

-- | Post context, no tags present:
postCtx :: Context String
postCtx =
    dateField "date" "%B %e, %Y" `mappend`
    defaultContext

-- | Post context, with tags:
postCtxWithTags :: Tags -> Context String
postCtxWithTags tags = tagsField "tags" tags `mappend` postCtx

-- | Context for feeds.
feedCtx :: Context String
feedCtx = postCtx `mappend` bodyField "description"