Introduce CLI, watch server, and bundled assets

Add data-files and bundled templates/fonts/css to the package and
rename the executable to hakysidian (autogen Paths_hakysidian).
Refactor site.hs to parse CLI commands (build/clean/rebuild/watch),
start a preview server, snapshot inputs and run an incremental watch
loop, and move rules into a siteRules function. Update ChaoDoc and
filters to accept math-macros, and add favicon links to templates.

hakysidian.cabal

@@ -1,13 +1,22 @@
+cabal-version:      2.4
 name:               hakysidian
 version:            0.1.0.0
 build-type:         Simple
-cabal-version:      >= 1.10
 
+data-files:
+    bib_style.csl
+    favicon.ico
+    css/*.css
+    fonts/*.otf
+    fonts/*.ttf
+    fonts/*.woff2
+    templates/*.html
 
-executable site
+executable hakysidian
   hs-source-dirs:   src
   main-is:          site.hs
-  other-modules:    ChaoDoc, SideNoteHTML, Pangu
+  other-modules:    ChaoDoc, SideNoteHTML, Pangu, Paths_hakysidian
+  autogen-modules:  Paths_hakysidian
   build-depends:    base   >= 4.18
                   , hakyll >= 4.15
                   , mtl >= 2.2.2
@@ -20,7 +29,11 @@ executable site
                   -- , process
                   -- , regex-compat
                   , array
+                  , directory
                   , filepath
+                  , time
+                  , wai-app-static
+                  , warp
                   -- , ghc-syntax-highlighter
                   -- , blaze-html >= 0.9
                   , megaparsec
@@ -34,4 +47,4 @@ executable site
                   -Wno-unsafe
                   -Wno-prepositive-qualified-module
                   -O2 -threaded -rtsopts -with-rtsopts=-N
-  default-language: Haskell2010
+  default-language: Haskell2010

makefile

@@ -1,5 +1,6 @@
 
 COMMANDS := build watch rebuild clean
+BIN := hakysidian
 .PHONY: $(COMMANDS), publish
 
 # Set the default goal, so running 'make' without arguments will run 'make build'.
@@ -7,20 +8,20 @@ COMMANDS := build watch rebuild clean
 
 
 # --- 
-$(COMMANDS): site
+$(COMMANDS): $(BIN)
-	@echo "Running command: ./site $@"
+	@echo "Running command: ./$(BIN) $@"
-	-@./site $@
+	-@./$(BIN) $@
 
 
 # --- Rules ---
 # using relative symlinks should be fine since everything only works at ./
 
 
-site: src/site.hs src/ChaoDoc.hs
+$(BIN): src/site.hs src/ChaoDoc.hs
-	cabal build
+	cabal build exe:hakysidian
-	ln -sf "$(shell cabal list-bin exe:site)" site
+	ln -sf "$(shell cabal list-bin exe:hakysidian)" $(BIN)
 
 # move from katex to mathjax
 # katex_cli:
 # 	cd katex_rust_fork && cargo build --release
-# 	ln -sf ./katex_rust_fork/target/release/katex_cli katex_cli
+# 	ln -sf ./katex_rust_fork/target/release/katex_cli katex_cli

src/ChaoDoc.hs

@@ -124,9 +124,9 @@ preprocessTheorems (Div attr xs)
     attr' = addAttr attr "type" theoremType
 preprocessTheorems x = return x
 
-theoremFilter :: Pandoc -> Pandoc
+theoremFilter :: Text -> Pandoc -> Pandoc
-theoremFilter doc =
+theoremFilter mathMacros doc =
-  walk makeTheorem $
+  walk (makeTheorem mathMacros) $
     autorefFilter $
       evalState (walkM preprocessTheorems normalizedDoc) 1
   where
@@ -171,24 +171,13 @@ autorefFilter x = walk (autoref links) x
   where
     links = query theoremIndex x
 
--- 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 "math-macros.md")
-{-# NOINLINE mathMacros #-}
-
 prependMacros :: Text -> Text -> Text
 prependMacros macros body = macros <> "\n\n" <> body
 
-prependMathMacros :: Text -> Text
+thmNamePandoc :: Text -> Text -> Pandoc
-prependMathMacros = prependMacros mathMacros
+thmNamePandoc mathMacros x =
-
-thmNamePandoc :: Text -> Pandoc
-thmNamePandoc x =
   fromRight (Pandoc nullMeta []) . runPure $
-    readMarkdown chaoDocRead (prependMathMacros x)
+    readMarkdown chaoDocRead (prependMacros mathMacros x)
 
 obsidianTheoremFilter :: Pandoc -> Pandoc
 obsidianTheoremFilter = attachStandaloneLabels . walk rewriteObsidianBlockQuote
@@ -390,8 +379,8 @@ unsnoc (x : xs) = do
   (prefix, lastElem) <- unsnoc xs
   return (x : prefix, lastElem)
 
-makeTheorem :: Block -> Block
+makeTheorem :: Text -> Block -> Block
-makeTheorem (Div attr xs)
+makeTheorem mathMacros (Div attr xs)
   | isNothing t = Div attr xs
   | otherwise = Div (addClass attr "theorem-environment") (Plain [header] : xs)
   where
@@ -408,26 +397,23 @@ makeTheorem (Div attr xs)
     nametext =
       if isNothing name
         then Str ""
-        else Span (addClass nullAttr "name") (pandocToInline $ thmNamePandoc $ fromJust name)
+        else Span (addClass nullAttr "name") (pandocToInline $ thmNamePandoc mathMacros $ fromJust name)
-makeTheorem x = x
+makeTheorem _ x = x
 
--- bib from https://github.com/chaoxu/chaoxu.github.io/tree/develop
+bibFile :: T.Text
-cslFile :: String
-cslFile = "bib_style.csl"
-
-bibFile :: String
 bibFile = "reference.bib"
 
-chaoDocPandocCompiler :: Compiler (Item Pandoc)
+chaoDocPandocCompiler :: FilePath -> Compiler (Item Pandoc)
-chaoDocPandocCompiler = do
+chaoDocPandocCompiler cslPath = do
   macros <- T.pack <$> loadBody "math-macros.md"
+  void (loadBody "reference.bib" :: Compiler String)
   body <- getResourceBody
   let bodyWithMacros =
         fmap (T.unpack . prependMacros macros . T.pack) body
-  myReadPandocBiblio chaoDocRead (T.pack cslFile) (T.pack bibFile) myFilter bodyWithMacros
+  myReadPandocBiblio chaoDocRead (T.pack cslPath) bibFile (myFilter macros) bodyWithMacros
 
-chaoDocCompiler :: Compiler (Item String)
+chaoDocCompiler :: FilePath -> Compiler (Item String)
-chaoDocCompiler = chaoDocPandocCompiler <&> writePandocWith chaoDocWrite
+chaoDocCompiler cslPath = chaoDocPandocCompiler cslPath <&> writePandocWith chaoDocWrite
 
 addMeta :: T.Text -> MetaValue -> Pandoc -> Pandoc
 addMeta name value (Pandoc meta a) =
@@ -465,8 +451,9 @@ myReadPandocBiblio ropt csl biblio pdfilter item = do
                         -- let a x = itemSetBody (pandoc' x)
   return $ fmap (const pandoc') item
 
-myFilter :: Pandoc -> Pandoc
+myFilter :: Text -> Pandoc -> Pandoc
-myFilter = usingSideNotesHTML chaoDocWrite . theoremFilter . panguFilter . displayMathFilter
+myFilter mathMacros =
+  usingSideNotesHTML chaoDocWrite . theoremFilter mathMacros . panguFilter . displayMathFilter
 
 -- pangu filter
 lastChar :: Inline -> Maybe Char

src/site.hs

@@ -2,115 +2,409 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE ViewPatterns #-}
 
 import ChaoDoc
-import Data.List (sortOn)
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Monad (filterM, unless, void, when)
+import Data.Kind (Type)
+import Data.List (intercalate, isPrefixOf, sort, sortOn)
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
+import Data.String (fromString)
 import qualified Data.Text as T
+import Data.Time.Clock (UTCTime)
 import Hakyll
+import Hakyll.Core.Runtime (RunMode (RunModeNormal))
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Paths_hakysidian as Paths
+import System.Directory
+  ( canonicalizePath,
+    doesDirectoryExist,
+    doesFileExist,
+    getCurrentDirectory,
+    getModificationTime,
+    listDirectory
+  )
+import System.Environment (getArgs)
+import System.Exit (ExitCode (..), die, exitSuccess, exitWith)
 import System.FilePath
-import Text.Pandoc
+import Network.Wai.Application.Static (staticApp)
+import Text.Pandoc (HTMLMathMethod (MathML), WriterOptions (..), compileTemplate)
+import Text.Read (readMaybe)
+
+--------------------------------------------------------------------------------
+
+notesPattern :: Pattern
+notesPattern = fromGlob "notes/**"
+
+bundledCssFiles :: [FilePath]
+bundledCssFiles =
+  [ "css/fonts.css",
+    "css/default.css",
+    "css/pygentize.css",
+    "css/chao-theorems.css",
+    "css/sidenotes.css"
+  ]
+
+bundledFontFiles :: [FilePath]
+bundledFontFiles =
+  [ "fonts/Lato-BoldItalic.woff2",
+    "fonts/IosevkaCustom-Bold.woff2",
+    "fonts/IosevkaCustom-Regular.woff2",
+    "fonts/Lato-Bold.woff2",
+    "fonts/Lato-Regular.woff2",
+    "fonts/IosevkaCustom-Italic.woff2",
+    "fonts/LeteSansMath.woff2",
+    "fonts/LeteSansMath-Bold.woff2",
+    "fonts/Lato-Italic.woff2"
+  ]
+
+bundledTemplateFiles :: [FilePath]
+bundledTemplateFiles =
+  [ "templates/head.html",
+    "templates/note.html",
+    "templates/notes.html",
+    "templates/notes-list.html",
+    "templates/index.html",
+    "templates/navbar.html"
+  ]
+
+type WatchSettings :: Type
+data WatchSettings = WatchSettings
+  { watchHost :: String,
+    watchPort :: Int,
+    watchServerEnabled :: Bool
+  }
+
+type CliCommand :: Type
+data CliCommand
+  = BuildCommand
+  | CleanCommand
+  | HelpCommand
+  | RebuildCommand
+  | WatchCommand WatchSettings
+
+type FileSnapshot :: Type
+type FileSnapshot = M.Map FilePath UTCTime
 
 --------------------------------------------------------------------------------
 -- https://www.rohanjain.in/hakyll-clean-urls/
 cleanRoute :: Routes
 cleanRoute = customRoute createIndexRoute
   where
-    createIndexRoute ident = takeDirectory p </> takeBaseName p </> "index.html"
+    createIndexRoute ident = takeDirectory path </> takeBaseName path </> "index.html"
       where
-        p = toFilePath ident
+        path = toFilePath ident
 
 cleanIndexHtmls :: Item String -> Compiler (Item String)
 cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
   where
-    pattern :: String = "/index.html"
+    pattern :: String
-    replacement :: String -> String = const "/"
+    pattern = "/index.html"
+
+    replacement :: String -> String
+    replacement = const "/"
 
 loadNoteLinks :: Compiler [Item String]
 loadNoteLinks = do
-  noteIds <- sortOn toFilePath <$> getMatches "notes/*"
+  noteIds <- sortOn toFilePath <$> getMatches notesPattern
   pure [Item noteId "" | noteId <- noteIds]
 
 --------------------------------------------------------------------------------
 
-config :: Configuration
+siteConfiguration :: FilePath -> Configuration
-config =
+siteConfiguration projectRoot =
   defaultConfiguration
-    { ignoreFile = \path ->
+    { destinationDirectory = projectRoot </> "_site",
-        ignoreFile defaultConfiguration path
+      storeDirectory = projectRoot </> "_cache",
-          || ".git" `elem` splitDirectories (normalise path)
+      tmpDirectory = projectRoot </> "_cache" </> "tmp",
+      providerDirectory = projectRoot,
+      ignoreFile = ignoreProjectFile (ignoreFile defaultConfiguration),
+      watchIgnore = ignoreProjectFile (watchIgnore defaultConfiguration)
     }
 
+ignoreProjectFile :: (FilePath -> Bool) -> FilePath -> Bool
+ignoreProjectFile defaultIgnore path = defaultIgnore path || ignoredProjectPath path
+
+ignoredProjectPath :: FilePath -> Bool
+ignoredProjectPath path =
+  any (`elem` [".git", ".obsidian"]) (splitDirectories (normalise path))
+
+--------------------------------------------------------------------------------
+
 main :: IO ()
-main = hakyllWith config $ do
+main = do
+  args <- getArgs
+  projectRoot <- canonicalizePath =<< getCurrentDirectory
+  let config = siteConfiguration projectRoot
+  cslPath <- Paths.getDataFileName "bib_style.csl"
+  case parseCliCommand config args of
+    Left err -> die (err <> "\n\n" <> usageText)
+    Right HelpCommand -> putStrLn usageText >> exitSuccess
+    Right CleanCommand ->
+      exitWith =<< runSiteCommand config cleanOptions cslPath
+    Right BuildCommand -> do
+      validateProject projectRoot
+      exitWith =<< runSiteCommand config buildOptions cslPath
+    Right RebuildCommand -> do
+      validateProject projectRoot
+      exitWith =<< runSiteCommand config rebuildOptions cslPath
+    Right (WatchCommand watchSettings) -> do
+      validateProject projectRoot
+      exitWith =<< runWatch projectRoot config cslPath watchSettings
+
+usageText :: String
+usageText =
+  unlines
+    [ "usage: hakysidian [build|clean|rebuild|watch [--host HOST] [--port PORT] [--no-server]]",
+      "",
+      "Run inside a project directory containing notes/, reference.bib, math-macros.md, and optional images/."
+    ]
+
+parseCliCommand :: Configuration -> [String] -> Either String CliCommand
+parseCliCommand config args
+  | any (`elem` ["-h", "--help"]) args = Right HelpCommand
+  | otherwise = case args of
+      [] -> Right BuildCommand
+      ["build"] -> Right BuildCommand
+      ["clean"] -> Right CleanCommand
+      ["rebuild"] -> Right RebuildCommand
+      "watch" : rest -> Right (WatchCommand (parseWatchSettings config rest))
+      command : _ -> Left ("Unknown command: " <> command)
+
+validateProject :: FilePath -> IO ()
+validateProject projectRoot = do
+  notesExists <- doesDirectoryExist (projectRoot </> "notes")
+  bibExists <- doesFileExist (projectRoot </> "reference.bib")
+  macrosExists <- doesFileExist (projectRoot </> "math-macros.md")
+  let missing :: [String]
+      missing =
+        [ "notes/"
+          | not notesExists
+        ]
+          ++ [ "reference.bib"
+               | not bibExists
+             ]
+          ++ [ "math-macros.md"
+               | not macrosExists
+             ]
+  unless (null missing) $
+    die $
+      unlines $
+        "hakysidian is missing required project inputs:" :
+        map ("  - " ++) missing
+
+renderWatchPanel :: FilePath -> Configuration -> WatchSettings -> IO ()
+renderWatchPanel projectRoot config watchSettings = do
+  notesExists <- doesDirectoryExist (projectRoot </> "notes")
+  bibExists <- doesFileExist (projectRoot </> "reference.bib")
+  macrosExists <- doesFileExist (projectRoot </> "math-macros.md")
+  imagesExists <- doesDirectoryExist (projectRoot </> "images")
+  let urlText = fromMaybe "disabled (--no-server)" (watchUrl watchSettings)
+      statusText =
+        "notes="
+          ++ presentStatus notesExists
+          ++ ", bib="
+          ++ presentStatus bibExists
+          ++ ", macros="
+          ++ presentStatus macrosExists
+          ++ ", images="
+          ++ optionalStatus imagesExists
+  mapM_
+    putStrLn
+    [ "------------------------------------------------------------",
+      "hakysidian watch",
+      "project  : " ++ projectRoot,
+      "output   : " ++ destinationDirectory config,
+      "url      : " ++ urlText,
+      "watching : notes/, reference.bib, math-macros.md, images/ (optional)",
+      "status   : " ++ statusText,
+      "------------------------------------------------------------"
+    ]
+
+presentStatus :: Bool -> String
+presentStatus True = "ok"
+presentStatus False = "missing"
+
+optionalStatus :: Bool -> String
+optionalStatus True = "present"
+optionalStatus False = "absent"
+
+parseWatchSettings :: Configuration -> [String] -> WatchSettings
+parseWatchSettings config args =
+  WatchSettings
+    { watchHost = fromMaybe (previewHost config) (extractOptionValue "--host" args),
+      watchPort =
+        fromMaybe (previewPort config) $
+          extractOptionValue "--port" args >>= readMaybe,
+      watchServerEnabled = "--no-server" `notElem` args
+    }
+
+watchUrl :: WatchSettings -> Maybe String
+watchUrl settings
+  | watchServerEnabled settings =
+      Just $
+        "http://"
+          ++ displayHost (watchHost settings)
+          ++ ":"
+          ++ show (watchPort settings)
+          ++ "/"
+  | otherwise = Nothing
+  where
+    displayHost :: String -> String
+    displayHost "0.0.0.0" = "127.0.0.1"
+    displayHost hostName = hostName
+
+extractOptionValue :: String -> [String] -> Maybe String
+extractOptionValue option = go
+  where
+    optionPrefix = option ++ "="
+
+    go :: [String] -> Maybe String
+    go [] = Nothing
+    go [arg]
+      | optionPrefix `isPrefixOf` arg = Just (drop (length optionPrefix) arg)
+      | otherwise = Nothing
+    go (arg : value : rest)
+      | arg == option = Just value
+      | optionPrefix `isPrefixOf` arg = Just (drop (length optionPrefix) arg)
+      | otherwise = go (value : rest)
+
+buildOptions :: Options
+buildOptions = Options {verbosity = False, optCommand = Build RunModeNormal}
+
+cleanOptions :: Options
+cleanOptions = Options {verbosity = False, optCommand = Clean}
+
+rebuildOptions :: Options
+rebuildOptions = Options {verbosity = False, optCommand = Rebuild}
+
+runSiteCommand :: Configuration -> Options -> FilePath -> IO ExitCode
+runSiteCommand config options cslPath =
+  hakyllWithExitCodeAndArgs config options (siteRules cslPath)
+
+runWatch :: FilePath -> Configuration -> FilePath -> WatchSettings -> IO ExitCode
+runWatch projectRoot config cslPath watchSettings = do
+  renderWatchPanel projectRoot config watchSettings
+  initialExit <- runSiteCommand config buildOptions cslPath
+  when (initialExit /= ExitSuccess) $
+    putStrLn "build    : initial build failed; continuing to watch for changes"
+  startPreviewServer config watchSettings
+  initialSnapshot <- snapshotInputs projectRoot
+  watchLoop initialSnapshot
+  where
+    watchLoop :: FileSnapshot -> IO ExitCode
+    watchLoop previousSnapshot = do
+      threadDelay 1000000
+      nextSnapshot <- snapshotInputs projectRoot
+      if nextSnapshot == previousSnapshot
+        then watchLoop previousSnapshot
+        else do
+          let changedFiles = diffSnapshots previousSnapshot nextSnapshot
+              options =
+                if any (`M.notMember` nextSnapshot) (M.keys previousSnapshot)
+                  then rebuildOptions
+                  else buildOptions
+          putStrLn ("change   : " ++ intercalate ", " changedFiles)
+          buildExit <- runSiteCommand config options cslPath
+          putStrLn ("build    : " ++ renderBuildResult buildExit)
+          watchLoop nextSnapshot
+
+renderBuildResult :: ExitCode -> String
+renderBuildResult ExitSuccess = "success"
+renderBuildResult (ExitFailure code) = "failed (" ++ show code ++ ")"
+
+startPreviewServer :: Configuration -> WatchSettings -> IO ()
+startPreviewServer config watchSettings
+  | watchServerEnabled watchSettings =
+      void $
+        forkIO $
+          Warp.runSettings settings $
+            staticApp $
+              previewSettings config (destinationDirectory config)
+  | otherwise = pure ()
+  where
+    settings =
+      Warp.setPort (watchPort watchSettings) $
+        Warp.setHost (fromString (watchHost watchSettings)) $
+          Warp.defaultSettings
+
+snapshotInputs :: FilePath -> IO FileSnapshot
+snapshotInputs projectRoot = do
+  inputFiles <- trackedInputs projectRoot
+  entries <- traverse toSnapshotEntry inputFiles
+  pure (M.fromList entries)
+  where
+    toSnapshotEntry :: FilePath -> IO (FilePath, UTCTime)
+    toSnapshotEntry path = do
+      modifiedAt <- getModificationTime path
+      pure (makeRelative projectRoot path, modifiedAt)
+
+trackedInputs :: FilePath -> IO [FilePath]
+trackedInputs projectRoot = do
+  requiredFiles <-
+    filterM
+      doesFileExist
+      [ projectRoot </> "reference.bib",
+        projectRoot </> "math-macros.md"
+      ]
+  noteFiles <- trackedFilesIn (projectRoot </> "notes")
+  imageFiles <- trackedFilesIn (projectRoot </> "images")
+  pure (sort (requiredFiles ++ noteFiles ++ imageFiles))
+
+trackedFilesIn :: FilePath -> IO [FilePath]
+trackedFilesIn root = do
+  exists <- doesDirectoryExist root
+  if exists
+    then do
+      entries <- listDirectory root
+      fmap concat $
+        traverse
+          ( \name -> do
+              let path = root </> name
+              isDir <- doesDirectoryExist path
+              if isDir
+                then trackedFilesIn path
+                else pure [path]
+          )
+          entries
+    else pure []
+
+diffSnapshots :: FileSnapshot -> FileSnapshot -> [FilePath]
+diffSnapshots previousSnapshot nextSnapshot =
+  sort
+    [ path
+      | path <- M.keys (M.union previousSnapshot nextSnapshot),
+        M.lookup path previousSnapshot /= M.lookup path nextSnapshot
+    ]
+
+--------------------------------------------------------------------------------
+
+siteRules :: FilePath -> Rules ()
+siteRules cslPath = do
   match "images/**" $ do
     route idRoute
     compile copyFileCompiler
 
-  match "math-macros.md" $ compile getResourceBody
+  match "math-macros.md" $
+    compile getResourceBody
 
-  match "fonts/*.woff2" $ do
+  match "reference.bib" $
-    route idRoute
+    compile getResourceBody
-    compile copyFileCompiler
 
-  match "favicon.ico" $ do
+  mapM_ createBundledCss bundledCssFiles
-    route idRoute
+  mapM_ createBundledCopy bundledFontFiles
-    compile copyFileCompiler
+  createBundledCopy "favicon.ico"
+  mapM_ createBundledTemplate bundledTemplateFiles
 
-  -- match "404.html" $ do
+  match notesPattern $ do
-  --   route cleanRoute
-  --   compile copyFileCompiler
-
-  match "css/*" $ do
-    route idRoute
-    compile compressCssCompiler
-
-  -- match "about.md" $ do
-  --   route cleanRoute
-  --   compile $
-  --     chaoDocCompiler
-  --       >>= loadAndApplyTemplate "templates/about.html" defaultContext
-  --       >>= relativizeUrls
-
-  -- -- build up tags
-  -- tags <- buildTags "posts/*" (fromCapture "tags/*.html")
-  -- tagsRules tags $ \tag pattern -> do
-  --   let title = "Posts tagged \"" ++ tag ++ "\""
-  --   route cleanRoute
-  --   compile $ do
-  --     posts <- recentFirst =<< loadAll pattern
-  --     let ctx =
-  --           constField "title" title
-  --             `mappend` listField "posts" (postCtxWithTags tags) (return posts)
-  --             `mappend` defaultContext
-  --     makeItem ""
-  --       >>= loadAndApplyTemplate "templates/tag.html" ctx
-  --       >>= loadAndApplyTemplate "templates/default.html" ctx
-  --       >>= relativizeUrls
-
-  -- create ["tags.html"] $ do
-  --   route cleanRoute
-  --   compile $ do
-  --     makeItem ""
-  --       >>= loadAndApplyTemplate "templates/tags.html" (defaultCtxWithTags tags)
-  --       >>= loadAndApplyTemplate "templates/default.html" (defaultCtxWithTags tags)
-
-  -- match "posts/*" $ do
-  --   route cleanRoute
-  --   compile $ do
-  --     tocCtx <- getTocCtx (postCtxWithTags tags)
-  --     chaoDocCompiler
-  --       >>= loadAndApplyTemplate "templates/post.html" tocCtx
-  --       >>= loadAndApplyTemplate "templates/default.html" tocCtx
-  --       >>= relativizeUrls
-  -- --    >>= katexFilter
-
-  match "notes/*" $ do
     route cleanRoute
     compile $ do
       notes <- loadNoteLinks
-      tocCtx <- getTocCtx $ listField "notes" defaultContext (return notes) <> defaultContext
+      tocCtx <- getTocCtx cslPath (listField "notes" defaultContext (pure notes) <> defaultContext)
-      chaoDocCompiler
+      chaoDocCompiler cslPath
         >>= loadAndApplyTemplate "templates/note.html" tocCtx
         >>= relativizeUrls
 
@@ -119,118 +413,63 @@ main = hakyllWith config $ do
     compile $ do
       notes <- loadNoteLinks
       let notesCtx =
-            listField "notes" defaultContext (return notes)
+            listField "notes" defaultContext (pure notes)
-              `mappend` constField "title" "Notes"
+              <> constField "title" "Notes"
-              `mappend` defaultContext
+              <> defaultContext
       makeItem ""
         >>= loadAndApplyTemplate "templates/notes.html" notesCtx
         >>= loadAndApplyTemplate "templates/index.html" notesCtx
         >>= relativizeUrls
         >>= cleanIndexHtmls
 
-  -- create ["archive.html"] $ do
+createBundledCss :: FilePath -> Rules ()
-  --   route cleanRoute
+createBundledCss relPath = create [fromFilePath relPath] $ do
-  --   compile $ do
+  route idRoute
-  --     posts <- recentFirst =<< loadAll "posts/*"
+  compile bundledCssCompiler
-  --     let archiveCtx =
-  --           listField "posts" postCtx (return posts)
-  --             `mappend` constField "title" "Archives"
-  --             `mappend` defaultContext
-  --     makeItem ""
-  --       >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
-  --       >>= loadAndApplyTemplate "templates/index.html" archiveCtx
-  --       >>= relativizeUrls
-  --       >>= cleanIndexHtmls
 
-  -- create ["draft.html"] $ do
+createBundledCopy :: FilePath -> Rules ()
-  --   route cleanRoute
+createBundledCopy relPath = create [fromFilePath relPath] $ do
-  --   compile $ do
+  route idRoute
-  --     posts <- recentFirst =<< loadAll "posts/*"
+  compile bundledCopyCompiler
-  --     let draftCtx =
-  --           listField "posts" postCtx (return posts)
-  --             `mappend` constField "title" "Drafts"
-  --             `mappend` defaultContext
-  --     makeItem ""
-  --       >>= loadAndApplyTemplate "templates/draft.html" draftCtx
-  --       >>= loadAndApplyTemplate "templates/index.html" draftCtx
-  --       >>= relativizeUrls
-  --       >>= cleanIndexHtmls
 
-  -- match "index.html" $ do
+createBundledTemplate :: FilePath -> Rules ()
-  --   route idRoute
+createBundledTemplate relPath =
-  --   compile $ do
+  create [fromFilePath relPath] $
-  --     posts <- fmap (take 25) . recentFirst =<< loadAll "posts/*"
+    compile bundledTemplateCompiler
-  --     let indexCtx =
-  --           listField "posts" postCtx (return posts)
-  --             `mappend` defaultContext
-  --     getResourceBody
-  --       >>= applyAsTemplate indexCtx
-  --       >>= loadAndApplyTemplate "templates/index.html" indexCtx
-  --       >>= relativizeUrls
-  --       >>= cleanIndexHtmls
 
-  match "templates/*" $ compile templateBodyCompiler
+bundledAssetPath :: Compiler FilePath
+bundledAssetPath = do
+  ident <- getUnderlying
+  unsafeCompiler $ Paths.getDataFileName (toFilePath ident)
 
--- https://robertwpearce.com/hakyll-pt-2-generating-a-sitemap-xml-file.html
+bundledTextCompiler :: Compiler (Item String)
--- create ["sitemap.xml"] $ do
+bundledTextCompiler = do
---   route idRoute
+  assetPath <- bundledAssetPath
---   compile $ do
+  contents <- unsafeCompiler (readFile assetPath)
---     posts <- recentFirst =<< loadAll "posts/*"
+  makeItem contents
---     singlePages <- loadAll (fromList ["about.md"])
+
---     let pages = posts <> singlePages
+bundledCssCompiler :: Compiler (Item String)
---         sitemapCtx =
+bundledCssCompiler = fmap compressCss <$> bundledTextCompiler
---           constField "root" root
+
---             <> listField "pages" postCtx (return pages) -- here
+bundledCopyCompiler :: Compiler (Item CopyFile)
---     makeItem ""
+bundledCopyCompiler = do
---       >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
+  assetPath <- bundledAssetPath
+  makeItem (CopyFile assetPath)
+
+bundledTemplateCompiler :: Compiler (Item Template)
+bundledTemplateCompiler = do
+  item <- bundledTextCompiler
+  template <- compileTemplateItem item
+  pure (itemSetBody template item)
 
 --------------------------------------------------------------------------------
 
--- isZhField :: Context String
--- isZhField = boolFieldM "isZh" isZh
---   where
---     isZh :: Item String -> Compiler Bool
---     isZh item = do
---       maybeLang <- getMetadataField (itemIdentifier item) "lang"
---       return (maybeLang == Just "zh")
-
--- postCtx :: Context String
--- postCtx =
---   dateField "date" "%B %e, %Y"
---     <> dateField "date" "%Y-%m-%d"
---     <> isZhField
---     <> defaultContext
-
--- postCtxWithTags :: Tags -> Context String
--- postCtxWithTags tags = tagsField "tags" tags `mappend` postCtx
-
--- defaultCtxWithTags :: Tags -> Context String
--- defaultCtxWithTags tags = listField "tags" tagsCtx getAllTags <> defaultContext
---   where
---     getAllTags :: Compiler [Item (String, [Identifier])]
---     getAllTags = pure . map mkItem $ tagsMap tags
---       where
---         mkItem :: (String, [Identifier]) -> Item (String, [Identifier])
---         mkItem x@(t, _) = Item (tagsMakeId tags t) x
---     tagsCtx =
---       listFieldWith "posts" (postCtxWithTags tags) getPosts
---         <> metadataField
---         <> urlField "url"
---         <> pathField "path"
---         <> titleField "title"
---         <> missingField
---       where
---         getPosts ::
---           Item (String, [Identifier]) ->
---           Compiler [Item String]
---         getPosts (itemBody -> (_, is)) = mapM load is
-
 -- toc from https://github.com/slotThe/slotThe.github.io
-getTocCtx :: Context a -> Compiler (Context a)
+getTocCtx :: FilePath -> Context a -> Compiler (Context a)
-getTocCtx ctx = do
+getTocCtx cslPath ctx = do
   noToc <- (Just "true" ==) <$> (getUnderlying >>= (`getMetadataField` "no-toc"))
   writerOpts <- mkTocWriter defaultHakyllWriterOptions
-  toc <- writePandocWith writerOpts <$> chaoDocPandocCompiler
+  toc <- writePandocWith writerOpts <$> chaoDocPandocCompiler cslPath
   pure $
     mconcat
       [ ctx,

templates/head.html

@@ -3,6 +3,7 @@
 <meta name="viewport" content="width=device-width, initial-scale=1" />
 <meta name="googlebot" content="noindex" />
 <title>$title$</title>
+<link rel="icon" href="/favicon.ico" />
 <link rel="stylesheet" href="/css/fonts.css" />
 <link rel="stylesheet" href="/css/default.css" />
 <link rel="stylesheet" href="/css/pygentize.css" />

templates/index.html

@@ -7,6 +7,7 @@
     <meta name="viewport" content="width=device-width, initial-scale=1">
     <meta name="googlebot" content="noindex">
     <title></title>
+    <link rel="icon" href="/favicon.ico" />
     <link rel="stylesheet" href="/css/fonts.css" />
     <link rel="stylesheet" href="/css/default.css" />
     <link rel="stylesheet" href="/css/pygentize.css" />
@@ -31,4 +32,4 @@
     </div>
 </body>
 
-</html>
+</html>