Refactor templates and update ChaoDoc module for improved structure and clarity

2026-04-09 00:07:51 +08:00
parent 5e0c735ed3
commit f592483e69
5 changed files with 101 additions and 72 deletions
--- a/assets/css/default.css
+++ b/assets/css/default.css
@@ -89,10 +89,9 @@ html body div.text-space main ul.post-list {
 header {
    font-weight: 400;
    font-family: "IosevkaC", sans-serif;
-}
-nav a {
-    display: inline-block;
+    font-size: 2rem;
    text-decoration: none;
+    line-height: 120%;
 }

 .uri {
--- a/assets/templates/default.html
+++ b/assets/templates/default.html
@@ -25,13 +25,15 @@
    </div>
    <div class="text-space">
        <header class="no-print">
-            <nav>
-                <a href="/">Home</a>
-            </nav>
+            <a href="/">/</a>
+            $title$
        </header>
        <main role="main">
-            <h1 class="pagetitle">$title$</h1>
+            <article>
+                <section class="body">
                    $body$
+                </section>
+            </article>
        </main>
        <footer></footer>
    </div>
--- a/assets/templates/post.html
+++ b/assets/templates/post.html
@@ -1,5 +0,0 @@
-<article> 
-    <section class="body">
-        $body$
-    </section>
-</article>
--- a/src/ChaoDoc.hs
+++ b/src/ChaoDoc.hs
@@ -1,13 +1,22 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneKindSignatures #-}

-module ChaoDoc (chaoDocRead, chaoDocWrite, chaoDocPandocCompiler, chaoDocCompiler) where
+module ChaoDoc
+  ( ChaoDocFiles (..),
+    chaoDocRead,
+    chaoDocWrite,
+    chaoDocPandocCompiler,
+    chaoDocCompiler,
+  )
+where

 import Control.Monad (guard)
 import Control.Monad.State
 import Data.Char (isSpace)
 import Data.Either
 import Data.Functor
+import Data.Kind (Type)
 import Data.List (find)
 import qualified Data.Map as M
 import Data.Maybe
@@ -16,19 +25,16 @@ import qualified Data.Text as T
 import Hakyll
 import Pangu (isCJK, pangu)
 import SideNoteHTML (usingSideNotesHTML)
-import System.IO.Unsafe
 import Text.Pandoc
 -- import Text.Pandoc.Builder
 import Text.Pandoc.Walk (query, walk, walkM)

-cslFile :: String
-cslFile = "assets/bib_style.csl"
-
-bibFile :: String
-bibFile = "ref.bib"
-
-macroFile :: String
-macroFile = "assets/math-macros.tex"
+type ChaoDocFiles :: Type
+data ChaoDocFiles = ChaoDocFiles
+  { chaoDocCslFile :: FilePath,
+    chaoDocBibFile :: FilePath,
+    chaoDocMacroFile :: FilePath
+  }

 -- On mac, please do `export LANG=C` before using this thing
 chaoDocRead :: ReaderOptions
@@ -52,23 +58,23 @@ chaoDocWrite =
      writerTOCDepth = 2
    }

-chaoDocPandocCompiler :: Compiler (Item Pandoc)
-chaoDocPandocCompiler = do
-  macros <- T.pack <$> loadBody (fromFilePath macroFile)
-  csl <- load $ fromFilePath cslFile
-  bib <- load $ fromFilePath bibFile
+chaoDocPandocCompiler :: ChaoDocFiles -> Compiler (Item Pandoc)
+chaoDocPandocCompiler paths = do
+  macros <- T.pack <$> loadBody (fromFilePath $ chaoDocMacroFile paths)
+  csl <- load $ fromFilePath $ chaoDocCslFile paths
+  bib <- load $ fromFilePath $ chaoDocBibFile paths
  body <- getResourceBody
  let bodyWithMacros =
        fmap (T.unpack . prependMacros macros . normalizeTheoremFenceTitles . T.pack) body
      prepare =
        addMeta "link-citations" (MetaBool True)
          . addMeta "reference-section-title" (MetaInlines [Str "References"])
-          . myFilter
+          . myFilter macros
  readPandocWith chaoDocRead bodyWithMacros
    >>= processPandocBiblio csl bib . fmap prepare

-chaoDocCompiler :: Compiler (Item String)
-chaoDocCompiler = chaoDocPandocCompiler <&> writePandocWith chaoDocWrite
+chaoDocCompiler :: ChaoDocFiles -> Compiler (Item String)
+chaoDocCompiler paths = chaoDocPandocCompiler paths <&> writePandocWith chaoDocWrite

 addMeta :: T.Text -> MetaValue -> Pandoc -> Pandoc
 addMeta name value (Pandoc meta a) =
@@ -77,8 +83,8 @@ addMeta name value (Pandoc meta a) =
      newMeta = Meta newMap
   in Pandoc newMeta a

-myFilter :: Pandoc -> Pandoc
-myFilter = usingSideNotesHTML chaoDocWrite . theoremFilter . panguFilter . equationFilter
+myFilter :: Text -> Pandoc -> Pandoc
+myFilter macros = usingSideNotesHTML chaoDocWrite . theoremFilter macros . panguFilter . equationFilter

 pandocToInline :: Pandoc -> [Inline]
 pandocToInline (Pandoc _ blocks) = go (reverse blocks)
@@ -184,8 +190,9 @@ normalizeTheoremClass :: Attr -> Text -> Attr
 normalizeTheoremClass (ident, classes, attrs) theoremType =
  (ident, theoremType : filter ((`notElem` theoremClasses) . normalizeBlockClass) classes, attrs)

-theoremFilter :: Pandoc -> Pandoc
-theoremFilter doc = walk makeTheorem $ autorefFilter $ evalState (walkM preprocessTheorems doc) 1
+theoremFilter :: Text -> Pandoc -> Pandoc
+theoremFilter macros doc =
+  walk (makeTheorem macros) $ autorefFilter $ evalState (walkM preprocessTheorems doc) 1

 --    [index, type, idx]
 theoremIndex :: Block -> [(Text, (Text, Text))]
@@ -281,27 +288,16 @@ equationAutoref x (Cite citations inlines)
    linkTitle = "Eq. (" <> num <> ")"
 equationAutoref _ y = y

-- processCitations works on AST. If you want to use citations in theorem name,
-- then you need to convert citations there to AST as well and then use processCitations\
-- Thus one need to apply the theorem filter first.
-- autoref still does not work.
-mathMacros :: Text
-mathMacros = unsafePerformIO (pack <$> readFile macroFile)
-{-# NOINLINE mathMacros #-}
-
 prependMacros :: Text -> Text -> Text
 prependMacros macros body = macros <> "\n\n" <> body

-prependMathMacros :: Text -> Text
-prependMathMacros = prependMacros mathMacros
-
-thmNamePandoc :: Text -> Pandoc
-thmNamePandoc x =
+thmNamePandoc :: Text -> Text -> Pandoc
+thmNamePandoc macros x =
  fromRight (Pandoc nullMeta []) . runPure $
-    readMarkdown chaoDocRead (prependMathMacros x)
+    readMarkdown chaoDocRead (prependMacros macros x)

-makeTheorem :: Block -> Block
-makeTheorem (Div attr xs)
+makeTheorem :: Text -> Block -> Block
+makeTheorem macros (Div attr xs)
  | isNothing t = Div attr xs
  | otherwise = Div (addClass attr "theorem-environment") (Plain [header] : xs)
  where
@@ -318,8 +314,8 @@ makeTheorem (Div attr xs)
    nametext =
      if isNothing name
        then Str ""
-        else Span (addClass nullAttr "name") (pandocToInline $ thmNamePandoc $ fromJust name)
-makeTheorem x = x
+        else Span (addClass nullAttr "name") (pandocToInline $ thmNamePandoc macros $ fromJust name)
+makeTheorem _ x = x

 -- pangu filter
 lastChar :: Inline -> Maybe Char
--- a/src/site.hs
+++ b/src/site.hs
@@ -9,8 +9,46 @@ import Hakyll
 import System.FilePath
 import Text.Pandoc

-mds :: Pattern
-mds = "main.md"
+notesPattern :: Pattern
+notesPattern = "main.md"
+
+imagesPattern :: Pattern
+imagesPattern = "images/**"
+
+mathMacrosPath :: FilePath
+mathMacrosPath = "assets/math-macros.tex"
+
+bibStylePath :: FilePath
+bibStylePath = "assets/bib_style.csl"
+
+bibliographyPath :: FilePath
+bibliographyPath = "ref.bib"
+
+fontsPattern :: Pattern
+fontsPattern = "assets/fonts/*"
+
+faviconPath :: FilePath
+faviconPath = "assets/favicon.ico"
+
+cssPattern :: Pattern
+cssPattern = "assets/css/*"
+
+templatesPattern :: Pattern
+templatesPattern = "assets/templates/*"
+
+templateDefault :: Identifier
+templateDefault = fromFilePath "assets/templates/default.html"
+
+templatePostlist :: Identifier
+templatePostlist = fromFilePath "assets/templates/post-list.html"
+
+chaoDocFiles :: ChaoDocFiles
+chaoDocFiles =
+  ChaoDocFiles
+    { chaoDocCslFile = bibStylePath,
+      chaoDocBibFile = bibliographyPath,
+      chaoDocMacroFile = mathMacrosPath
+    }

 config :: Configuration
 config =
@@ -22,52 +60,51 @@ config =

 main :: IO ()
 main = hakyllWith config $ do
-  match "images/**" $ do
+  match imagesPattern $ do
    route idRoute
    compile copyFileCompiler

-  match "assets/math-macros.tex" $ compile getResourceBody
+  match (fromGlob mathMacrosPath) $ compile getResourceBody

-  match "assets/bib_style.csl" $ compile cslCompiler
+  match (fromGlob bibStylePath) $ compile cslCompiler

-  match "ref.bib" $ compile biblioCompiler
+  match (fromGlob bibliographyPath) $ compile biblioCompiler

-  match "assets/fonts/*" $ do
+  match fontsPattern $ do
    route $ gsubRoute "assets/fonts/" (const "fonts/")
    compile copyFileCompiler

-  match "assets/favicon.ico" $ do
+  match (fromGlob faviconPath) $ do
    route $ constRoute "favicon.ico"
    compile copyFileCompiler

-  match "assets/css/*" $ do
+  match cssPattern $ do
    route $ gsubRoute "assets/css/" (const "css/")
    compile compressCssCompiler

-  match mds $ do
+  match notesPattern $ do
    route $ setExtension "html"
    compile $ do
      tocCtx <- getTocCtx defaultContext
-      chaoDocCompiler
-        >>= loadAndApplyTemplate "assets/templates/post.html" tocCtx
-        >>= loadAndApplyTemplate "assets/templates/default.html" tocCtx
+      chaoDocCompiler chaoDocFiles
+        >>= loadAndApplyTemplate templateDefault tocCtx
        >>= relativizeUrls

  create ["index.html"] $ do
    route idRoute
    compile $ do
-      posts <- loadAll mds
+      posts <- loadAll notesPattern
      let indexCtx =
-            constField "title" "Notes"
+            constField "title" ""
              `mappend` constField "toc" ""
              `mappend` listField "posts" postCtx (return posts)
              `mappend` defaultContext
      makeItem ""
-        >>= loadAndApplyTemplate "assets/templates/post-list.html" indexCtx
-        >>= loadAndApplyTemplate "assets/templates/default.html" indexCtx
+        >>= loadAndApplyTemplate templatePostlist indexCtx
+        >>= loadAndApplyTemplate templateDefault indexCtx
        >>= relativizeUrls

-  match "assets/templates/*" $ compile templateBodyCompiler
+  match templatesPattern $ compile templateBodyCompiler

 postCtx :: Context String
 postCtx =
@@ -80,7 +117,7 @@ getTocCtx :: Context a -> Compiler (Context a)
 getTocCtx ctx = do
  noToc <- (Just "true" ==) <$> (getUnderlying >>= (`getMetadataField` "no-toc"))
  writerOpts <- mkTocWriter defaultHakyllWriterOptions
-  toc <- writePandocWith writerOpts <$> chaoDocPandocCompiler
+  toc <- writePandocWith writerOpts <$> chaoDocPandocCompiler chaoDocFiles
  pure $
    mconcat
      [ ctx,