This website is genereated with Hakyll, a static site generator written in Haskell. I’ve always wanted to try out Haskell, so I took this as an excuse to finally do it, mainly going off the standard site that hakyll initializes automatically and the various tutorials linked on the Hakyll site. Haskell’s syntax and concepts are still quite foreign to me, so given my background I keep mumbling “A monad is just a monoid on the category of endofunctors” to try to understand what’s going on.
These are the haskell imports
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
import Data.Monoid (mappend)
import Hakyll
import Hakyll.Core.Store (hash)
import Text.Pandoc.Builder (setMeta, nullAttr)
import Text.Pandoc.Walk (walk, walkM)
import Text.Pandoc.Definition (Block (..), Inline (..), MathType (..), Pandoc)
import Text.Pandoc.Options (ReaderOptions (..), WriterOptions (..))
import Text.Pandoc.Templates (compileTemplate)
import Text.Pandoc (HTMLMathMethod (..))
import qualified Data.Text as Text
import Control.Monad ((>=>))
import Data.ByteString.Lazy.Char8 (pack, unpack)
import System.Directory (createDirectoryIfMissing)
--------------------------------------------------------------------------------
Compiling Tikz pictures §
A very convenient feature is being able to integrate TikZ graphics
into code blocks and have them get rendered automatically, without
having to wrestle with LaTeX and PDF to Image converters. This is
achieved by the following code, adapted from [Bar-19], except
that out of personal preference my version writes the generated SVGs
to files instead of using data:
URLs. See below for an example:
As an enhancement over the version presented in [Bar-19], my
setup supports commutative diagrams by applying the tikzcd
tag to
the code environment, this is implemented by passing the appropriate
template name to the convertTikz
function defined below:
convertTikz :: Block -> Identifier -> Compiler Block
CodeBlock (id, classes, namevals) contents) templatename = do
convertTikz (let name = "/images/tikz/" <> hash [Text.unpack contents] <> ".svg"
let filename = "_site" <> name
$ createDirectoryIfMissing True "_site/images/tikz"
unsafeCompiler
makeItem contents>>= loadAndApplyTemplate templatename (bodyField "body") . fmap Text.unpack
>>= withItemBody (return . pack
>=> unixFilterLBS "rubber-pipe" ["--pdf"]
>=> unixFilterLBS "pdftocairo" ["-svg", "-", filename ]
>=> return . unpack)
return $ Para [Image (id, classes, namevals) [] (Text.pack name, "")]
Then we just need to define which template gets passed for which tag, which is easily doable using pattern matching. For now, both conventional tikzpictures and commutative diagrams both share the same tikzpicture CSS class in the output, but this may change at a later date depending on my needs.
tikzFilter :: Block -> Compiler Block
CodeBlock (id, "tikzpicture":extraClasses, namevals) contents) = convertTikz (CodeBlock (id, "tikzpicture":extraClasses, namevals) contents) "templates/tikz.tex"
tikzFilter (CodeBlock (id, "tikzcd":extraClasses, namevals) contents) = convertTikz (CodeBlock (id, "tikzpicture":extraClasses, namevals) contents) "templates/tikzcd.tex"
tikzFilter (= return x tikzFilter x
Adding a BibTeX Bibliography §
Another key feature of this Hakyll setup is the ability to add a bibliography to each post for academic pretentiousness. The setup is based on the one described in [Zorm23], but simplified slightly. It also enables section links, as described in [Twee20]. It also enables MathML output in Pandoc, as at least current (as of late 2024) LTS Firefox do a decent job at rendering it and I don’t really feel like overcomplicating the whole math rendering affair with JavaScript or Server-side rendering solutions.
myPandocBiblioCompiler :: Compiler (Item String)
= do
myPandocBiblioCompiler <- load "bib/bibliography.bib"
bibFile <- load "bib/style.csl"
cslFile let wOptions = defaultHakyllWriterOptions
{= MathML
writerHTMLMathMethod
}
getResourceBody>>= readPandocWith defaultHakyllReaderOptions
>>= pure . fmap (setMeta "link-citations" True)
>>= processPandocBiblio cslFile bibFile
>>= walkM tikzFilter
>>= pure . fmap (addSectionLinks . insertRefHeading) >>= pure . writePandocWith wOptions
where
insertRefHeading :: Pandoc -> Pandoc
= walk $ concatMap \case
insertRefHeading @(Div ("refs", _, _) _) -> [Header 2 ("references", [], []) [Str "References"], d]
d-> [block]
block addSectionLinks :: Pandoc -> Pandoc
= walk f where
addSectionLinks Header n attr@(id,_,_) inlines) | n > 1 =
f (let link = Link ("", ["section-link"], []) [ Str "§" ] ("#" <> id, "")
in Header n attr (inlines <> [Space, link])
= x f x
Compiling the Site §
In this section we actually compile the site, these rules follow
largely the standard website created when running hakyll-init
. Note
the rule for site.lhs
, which generates this page from the source
code of the generator itself using the same approach as
[terr24]. Another departure from the standard site was enabling
scss compilation to avoid repeating myself in the stylesheets.
Another feature is exif metadata stripping, which is applied to all in the images/strip_location/ folder, which makes sure that the exif metadata is stripped from images taken at locations that should not be disclosed, while keeping the location info intact where it is not relevant for privacy.
main :: IO ()
= hakyll $ do
main "images/strip_location/*" $ do
match $ gsubRoute "/strip_location" (const "")
route $ getResourceLBS >>= withItemBody (unixFilterLBS "exiftool" ["-gps*=", "-"])
compile
"images/*" $ do
match
route idRoute
compile copyFileCompiler"bib/style.csl" $ compile cslCompiler
match "bib/bibliography.bib" $ compile biblioCompiler
match "css/*.css" $ do
match
route idRoute
compile compressCssCompiler
"css/styles.scss" $ do
match $ setExtension "css"
route $ getResourceString >>=
compile "sass" ["-s", "--scss"]) >>=
withItemBody (unixFilter return . fmap compressCss
"static/*" $ do
match
route idRoute
compile copyFileCompiler
"about.rst", "contact.markdown"]) $ do
match (fromList [$ setExtension "html"
route $ pandocCompiler
compile >>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
"posts/*" $ do
match $ setExtension "html"
route $ myPandocBiblioCompiler
compile >>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/post.html" postCtx
>>= loadAndApplyTemplate "templates/default.html" postCtx
>>= relativizeUrls
"archive.html"] $ do
create [
route idRoute$ do
compile <- recentFirst =<< loadAll "posts/*"
posts let archiveCtx =
"posts" postCtx (return posts) `mappend`
listField "title" "Archives" `mappend`
constField
defaultContext
""
makeItem >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
>>= loadAndApplyTemplate "templates/default.html" archiveCtx
>>= relativizeUrls
"site.lhs" $ do
match $ customRoute (const "hakyll-setup.html")
route $ myPandocBiblioCompiler
compile >>= loadAndApplyTemplate "templates/post.html" defaultContext
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
"index.html" $ do
match
route idRoute$ do
compile <- recentFirst =<< loadAll "posts/*"
posts let indexCtx =
"posts" postCtx (return posts) `mappend`
listField
defaultContext
getResourceBody>>= applyAsTemplate indexCtx
>>= loadAndApplyTemplate "templates/default.html" indexCtx
>>= relativizeUrls
"templates/*" $ compile templateBodyCompiler
match
"rss.xml"] $ do
create [
route idRoute$ do
compile let feedCtx = postCtx `mappend` bodyField "description"
<- loadAllSnapshots "posts/*" "content"
posts >>= recentFirst
renderRss feedConfiguration feedCtx posts
--------------------------------------------------------------------------------
postCtx :: Context String
=
postCtx "date" "%B %e, %Y" `mappend`
dateField
defaultContext
feedConfiguration :: FeedConfiguration
= FeedConfiguration
feedConfiguration = "antonia.is"
{ feedTitle = "Antonia's thoughts"
, feedDescription = "antonia"
, feedAuthorName = "antonia@antonia.is"
, feedAuthorEmail = "https://antonia.is"
, feedRoot }