1 Prerequisites

{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative (Alternative (empty))
import Data.Char (isLower, toLower)
import Data.Monoid ((<>))
import Hakyll
import Site.MathJax
import Skylighting (styleToCss, pygments)
import System.FilePath
import Text.CSL.Pandoc (processCites')
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Walk (walkM)
import qualified Data.HashMap.Strict as HMS
import qualified Data.Scientific as Scientific
import qualified Data.Yaml as Yaml
import qualified Network.URI as URI

On Debian 10 “Buster”, the following packages are required:

apt install libghc-hakyll-dev libghc-io-streams-dev npm

As non-root user, the required JavaScript modules are installed within the working tree:

npm ci

The Makefile compiles the site program and deploys the website to a separate git branch.

2 Math rendering

The program begins by spawning MathJax in a background Node.js process.

main :: IO ()
main = do
  renderMath <- runMathJax

Rather than rendering each page separately using Hakyll’s unixFilter and incurring the overhead of loading MathJax repeatedly, the program communicates with this background process via standard input and output streams to render all mathematical equations. A Pandoc filter submits each equation in TeX format to the MathJax process as a JSON-encoded request and receives the typeset HTML (see MathJax.hs and MathJax.js).

3 Pandoc compiler

A custom Pandoc compiler converts pages from Markdown to HTML.

  let pageCompiler = getResourceBody
        >>= readPandoc
        >>= withItemBody (walkM $ transformRelativeReference)
        >>= withItemBody (unsafeCompiler . renderMath)
        >>= withItemBody (unsafeCompiler . processCites')
        >>= writePandocWithToc

The Markdown is parsed into a Pandoc AST, which is processed with a chain of Pandoc filters. A bibliography is created with pandoc-citeproc from references given in a separate YAML metadata block that is parsed by Pandoc (see, e.g., nano-dimer/README.md). The AST is rendered as HTML, optionally prepending a table of contents.

4 Hakyll rules

Hakyll is invoked with a set of routes and compilation rules for the site’s resources, where a route is the path of a resource in the output directory. Hakyll tracks dependencies between resources and recompiles pages when the underlying sources are updated, which is particularly useful when previewing drafts with the built-in webserver.

  hakyll $ do
    match ("*.asc" .||. "*.js" .||. "fonts/*") $ do
      route idRoute
      compile copyFileCompiler

The style sheet is created by concatenating and minimizing all CSS source files.

    create ["site.css"] $ do
      route idRoute
      compile $ makeItem =<< compressCss . concatMap itemBody <$> loadAll "css/*.css"

    match "css/*.css" $ compile getResourceBody

    create ["css/highlight.css"] $
      compile $ makeItem =<< return (styleToCss pygments)

    match "node_modules/mathjax-full/es5/output/chtml/fonts/woff-v2/*.woff" $ do
      route $ customRoute $ (`replaceDirectory` "fonts") . toFilePath
      compile copyFileCompiler

After Pandoc compilation, the page template adds the title, navigation menu and footer.

    match ("*.md" .||. "*.lhs") $ do
      route $ cleanRoute
      compile $ do
        identifier <- getUnderlying
        let context = bodyField "body" <>
                      homeField "home" identifier "index.md" <>
                      pageContext

        pageCompiler >>= loadAndApplyTemplate "templates/page.html" context

    match "templates/*" $ compile templateBodyCompiler

Projects have their own home page and navigation menu.

    match ("*/*.md" .||. "*/doc/*.md") $ do
      route $ gsubRoute "/doc/" (const "/") `composeRoutes` cleanRoute
      compile $ do
        identifier <- getUnderlying
        let project = fromFilePath . (</> "README.md") . head . splitPath . toFilePath
            context = bodyField "body" <>
                      homeField "home" identifier "index.md" <>
                      homeField "project" identifier (project identifier) <>
                      pageContext

        pageCompiler >>= loadAndApplyTemplate "templates/page.html" context

    match ("*/doc/*.svg" .||. "*/doc/*.png") $ do
      route $ gsubRoute "/doc/" (const "/")
      compile copyFileCompiler

5 Clean routes

For user-friendly URLs, each page is stored in a separate directory with the filename index.html.

cleanRoute :: Routes
cleanRoute = customRoute $
  joinPath . map allUpperToLower . splitPath . addIndexHtml . toFilePath

addIndexHtml :: FilePath -> FilePath
addIndexHtml path
  | takeBaseName path `elem` ["index", "README"] = replaceFileName path "index.html"
  | otherwise = dropExtension path </> "index.html"

All-uppercase path elements are transformed to lowercase, e.g., NEWS.md becomes news/index.html.

allUpperToLower :: String -> String
allUpperToLower s
  | any isLower s = s
  | otherwise = map toLower s

The filename index.html is stripped when referencing pages within the website.

cleanUrl :: String -> String
cleanUrl url
  | takeFileName url == "index.html" = takeDirectory url
  | otherwise = url

cleanUrlField :: String -> Context a
cleanUrlField = mapContext cleanUrl . urlField

6 Navigation menu

The pages for the navigation menu are given as a list of relative paths in the home page’s metadata.

homeField :: String -> Identifier -> Identifier -> Context a
homeField key identifier home =
  listField key context (return [loadWithoutBody home])
  where context = homeContext $ menuContext identifier

homeContext :: Context () -> Context ()
homeContext context = menuField "menu" context <> context

menuField :: String -> Context () -> Context ()
menuField key context = listFieldWith key context $ \item -> do
  let identifier = itemIdentifier item
  metadata <- getMetadata identifier
  let load' = loadWithoutBody . (`relativeIdentifier` identifier)
  maybe empty (return . map load') $ lookupStringList key metadata

To avoid circular dependencies between pages, only the metadata is loaded.

loadWithoutBody :: Identifier -> Item ()
loadWithoutBody identifier = Item identifier ()

The current page is highlighted in the navigation menu.

menuContext :: Identifier -> Context a
menuContext identifier =
  boolField "current" ((== identifier) . itemIdentifier) <>
  pageContext

An optional, e.g., shorter pagetitle is preferred over a longer title.

pageContext :: Context a
pageContext =
  cleanUrlField "url" <>
  metadataField <>
  aliasField "pagetitle" "title" <>
  missingField

aliasField :: String -> String -> Context a
aliasField key target = field key $ \item ->
  maybe empty return =<< getMetadataField (itemIdentifier item) target

7 Relative references

Images and links to internal resources are given as relative references. A Pandoc filter transforms the relative references to the corresponding routes, preserving the fragment identifier that links to a section of a page.

transformRelativeReference :: Inline -> Compiler Inline
transformRelativeReference (Image attr text (url, title)) = do
  url' <- relativeReference url
  return $ Image attr text (url', title)

transformRelativeReference (Link attr text (url, title)) = do
  url' <- relativeReference url
  return $ Link attr text (url', title)

transformRelativeReference x = return x

relativeReference :: String -> Compiler String
relativeReference url = case URI.parseRelativeReference url of
  Just uri@URI.URI { URI.uriPath = path@(_:_) } -> do
    identifier <- getUnderlying
    value <- getRoute $ relativeIdentifier path identifier
    case value of
      Just path' -> return $ show $ uri { URI.uriPath = cleanUrl $ toUrl path' }
      Nothing -> fail $ "invalid reference " ++ url
  _ -> return url

relativeIdentifier :: FilePath -> Identifier -> Identifier
relativeIdentifier path =
  fromFilePath . dropDrive . URI.uriPath . URI.relativeTo (uri path) . uri . toFilePath
  where uri p = URI.nullURI { URI.uriPath = p }

8 Table of contents

If the metadata contains a toc field, a table of contents is generated from headings down to the given depth.

writePandocWithToc :: Item Pandoc -> Compiler (Item String)
writePandocWithToc item = do
  metadata <- getMetadata (itemIdentifier item)
  (`writePandocWith` item) <$>
    case HMS.lookup "toc" metadata of
      Just (Yaml.Number value) -> case Scientific.toBoundedInteger value of
        Just depth -> return $ writerOptionsWithToc depth
        Nothing -> fail $ "invalid toc depth " ++ show value
      _ -> return writerOptions

writerOptionsWithToc :: Int -> WriterOptions
writerOptionsWithToc depth = writerOptions
  { writerTableOfContents = True
  , writerTOCDepth = depth
  , writerTemplate = Just "$if(toc)$<nav class=\"toc\">\n$toc$\n</nav>\n$endif$$body$"
  , writerNumberSections = True
  }

writerOptions :: WriterOptions
writerOptions = def
  { writerSectionDivs = True
  }