From 6772e304c049cf44bbf47b445b04c8e45c16c128 Mon Sep 17 00:00:00 2001
From: Stefan Kreutz <mail@skreutz.com>
Date: Sat, 6 Jul 2024 23:20:29 +0200
Subject: Append anchors to headings

---
 site.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 50 insertions(+), 4 deletions(-)

(limited to 'site.hs')

diff --git a/site.hs b/site.hs
index 1244959..c016f04 100644
--- a/site.hs
+++ b/site.hs
@@ -5,6 +5,9 @@ import Control.Monad.Fail (MonadFail)
 import Data.Time (TimeLocale, formatTime, parseTimeM, defaultTimeLocale, UTCTime)
 import Hakyll
 import System.FilePath.Posix ((</>), (<.>), splitExtension, splitFileName, takeDirectory)
+import Text.Pandoc (Pandoc, Inline(Link, Space, Str), Block(Header))
+import Text.Pandoc.Shared (stringify)
+import Text.Pandoc.Walk (walk)
 
 main :: IO ()
 main = hakyllWith hakyllConfig $ do
@@ -20,13 +23,13 @@ main = hakyllWith hakyllConfig $ do
   match (fromList ["about.md", "contact.md", "privacy.md", "code.md"]) $ do
     route $ setExtension "html" `composeRoutes` appendIndex
     let context = dropIndexHtml "url" <> defaultContext
-    compile $ pandocCompiler
+    compile $ customPandocCompiler
       >>= loadAndApplyTemplate "templates/direct.html" context
       >>= loadAndApplyTemplate "templates/default.html" context
 
   match "posts/*" $ do
     route $ setExtension "html" `composeRoutes` appendIndex
-    compile $ pandocCompiler
+    compile $ customPandocCompiler
       >>= loadAndApplyTemplate "templates/post.html" postContext
       >>= saveSnapshot "content"
       >>= loadAndApplyTemplate "templates/default.html" postContext
@@ -80,12 +83,12 @@ main = hakyllWith hakyllConfig $ do
 
   match "err.html" $ do
     route idRoute
-    compile $ pandocCompiler
+    compile $ customPandocCompiler
       >>= loadAndApplyTemplate "templates/default.html" defaultContext
 
   match "404.html" $ do
     route idRoute
-    compile $ pandocCompiler
+    compile $ customPandocCompiler
       >>= loadAndApplyTemplate "templates/default.html" defaultContext
 
   match "templates/*" $ compile templateBodyCompiler
@@ -207,3 +210,46 @@ getUpdatedUTC locale id' = do
       , "%B %e, %Y"
       , "%b %d, %Y"
       ]
+
+-- Example: Add Pandoc extension.
+-- Source: <https://tholzschuh.github.io/posts/using-latex-with-hakyll/>
+-- (archive: <https://web.archive.org/web/20240706211050/https://tholzschuh.github.io/posts/using-latex-with-hakyll/>)
+--
+-- import Text.Pandoc.Options
+-- customPandocCompiler :: Compiler (Item String)
+-- customPandocCompiler =
+--   let customExtensions = extensionsFromList [Ext_auto_identifiers]
+--       defaultExtensions = writerExtensions defaultHakyllWriterOptions
+--       newExtensions = defaultExtensions <> customExtensions
+--       writerOptions = defaultHakyllWriterOptions {
+--                         writerExtensions = newExtensions
+--                       }
+--   in pandocCompilerWith defaultHakyllReaderOptions writerOptions
+
+-- Custom compiler to append heading anchors.
+--
+-- Derived from <https://frasertweedale.github.io/blog-fp/posts/2020-12-10-hakyll-section-links.html>
+-- (archive: <https://web.archive.org/web/20240706210614/https://frasertweedale.github.io/blog-fp/posts/2020-12-10-hakyll-section-links.html>).
+--
+-- See also <https://www.aronwith1a.com/posts/hakyll-automatic-anchors.html>
+-- (archive: <https://web.archive.org/web/20240706210648/https://www.aronwith1a.com/posts/hakyll-automatic-anchors.html>),
+-- and
+-- <https://stackoverflow.com/questions/77944576/how-to-add-heading-links-in-hakyll-pandoc>
+-- (archive: <https://web.archive.org/web/20240706210702/https://stackoverflow.com/questions/77944576/how-to-add-heading-links-in-hakyll-pandoc>).
+customPandocCompiler :: Compiler (Item String)
+customPandocCompiler =
+  pandocCompilerWithTransform
+    defaultHakyllReaderOptions
+    defaultHakyllWriterOptions
+    $ walk appendAnchor
+  where
+    appendAnchor :: Block -> Block
+    appendAnchor header@(Header level attr@(identifier, _, _) contents) | level > 1 =
+      let linkClass = "anchor"
+          linkAttr = ("", [linkClass], [])
+          linkDestination = "#" <> identifier
+          linkTitle = stringify contents
+          linkContents = [ Str "#" ]
+          link = Link linkAttr linkContents (linkDestination, linkTitle)
+       in Header level attr (contents <> [ Space, link ])
+    appendAnchor block = block
-- 
cgit v1.2.3