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

---
 blog.cabal   |  2 ++
 css/site.css | 12 ++++++------
 site.hs      | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++----
 3 files changed, 58 insertions(+), 10 deletions(-)

diff --git a/blog.cabal b/blog.cabal
index c0c8c9a..03b9035 100644
--- a/blog.cabal
+++ b/blog.cabal
@@ -13,6 +13,8 @@ executable site
   build-depends:    base
                   , hakyll
                   , filepath
+		  , pandoc
+		  , pandoc-types
                   , time
   ghc-options:      -threaded
   default-language: Haskell2010
diff --git a/css/site.css b/css/site.css
index a2ffb90..379d9e8 100644
--- a/css/site.css
+++ b/css/site.css
@@ -129,12 +129,12 @@ h6 {
   /* color: var(--accent-color); */
 }
 
-h1 > a,
-h2 > a,
-h3 > a,
-h4 > a,
-h5 > a,
-h6 > a {
+h1 > a:not(.anchor),
+h2 > a:not(.anchor),
+h3 > a:not(.anchor),
+h4 > a:not(.anchor),
+h5 > a:not(.anchor),
+h6 > a:not(.anchor) {
   color: inherit;
   text-decoration: inherit;
 }
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