diff --git a/hakysidian.cabal b/hakysidian.cabal
index d3b3eb3..5843779 100644
--- a/hakysidian.cabal
+++ b/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
\ No newline at end of file
+ default-language: Haskell2010
diff --git a/makefile b/makefile
index 50a7e9e..51def8a 100644
--- a/makefile
+++ b/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
- @echo "Running command: ./site $@"
- -@./site $@
+$(COMMANDS): $(BIN)
+ @echo "Running command: ./$(BIN) $@"
+ -@./$(BIN) $@
# --- Rules ---
# using relative symlinks should be fine since everything only works at ./
-site: src/site.hs src/ChaoDoc.hs
- cabal build
- ln -sf "$(shell cabal list-bin exe:site)" site
+$(BIN): src/site.hs src/ChaoDoc.hs
+ cabal build exe:hakysidian
+ 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
\ No newline at end of file
+# ln -sf ./katex_rust_fork/target/release/katex_cli katex_cli
diff --git a/src/ChaoDoc.hs b/src/ChaoDoc.hs
index 474c30c..3102712 100644
--- a/src/ChaoDoc.hs
+++ b/src/ChaoDoc.hs
@@ -124,9 +124,9 @@ preprocessTheorems (Div attr xs)
attr' = addAttr attr "type" theoremType
preprocessTheorems x = return x
-theoremFilter :: Pandoc -> Pandoc
-theoremFilter doc =
- walk makeTheorem $
+theoremFilter :: Text -> Pandoc -> Pandoc
+theoremFilter mathMacros doc =
+ 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
-prependMathMacros = prependMacros mathMacros
-
-thmNamePandoc :: Text -> Pandoc
-thmNamePandoc x =
+thmNamePandoc :: Text -> Text -> Pandoc
+thmNamePandoc mathMacros 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 (Div attr xs)
+makeTheorem :: Text -> Block -> Block
+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)
-makeTheorem x = x
+ else Span (addClass nullAttr "name") (pandocToInline $ thmNamePandoc mathMacros $ fromJust name)
+makeTheorem _ x = x
--- bib from https://github.com/chaoxu/chaoxu.github.io/tree/develop
-cslFile :: String
-cslFile = "bib_style.csl"
-
-bibFile :: String
+bibFile :: T.Text
bibFile = "reference.bib"
-chaoDocPandocCompiler :: Compiler (Item Pandoc)
-chaoDocPandocCompiler = do
+chaoDocPandocCompiler :: FilePath -> Compiler (Item Pandoc)
+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 = chaoDocPandocCompiler <&> writePandocWith chaoDocWrite
+chaoDocCompiler :: FilePath -> Compiler (Item String)
+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 = usingSideNotesHTML chaoDocWrite . theoremFilter . panguFilter . displayMathFilter
+myFilter :: Text -> Pandoc -> Pandoc
+myFilter mathMacros =
+ usingSideNotesHTML chaoDocWrite . theoremFilter mathMacros . panguFilter . displayMathFilter
-- pangu filter
lastChar :: Inline -> Maybe Char
diff --git a/src/site.hs b/src/site.hs
index 214b994..f856e5f 100644
--- a/src/site.hs
+++ b/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"
- replacement :: String -> String = const "/"
+ pattern :: String
+ 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
-config =
+siteConfiguration :: FilePath -> Configuration
+siteConfiguration projectRoot =
defaultConfiguration
- { ignoreFile = \path ->
- ignoreFile defaultConfiguration path
- || ".git" `elem` splitDirectories (normalise path)
+ { destinationDirectory = projectRoot "_site",
+ storeDirectory = projectRoot "_cache",
+ 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
- route idRoute
- compile copyFileCompiler
+ match "reference.bib" $
+ compile getResourceBody
- match "favicon.ico" $ do
- route idRoute
- compile copyFileCompiler
+ mapM_ createBundledCss bundledCssFiles
+ mapM_ createBundledCopy bundledFontFiles
+ createBundledCopy "favicon.ico"
+ mapM_ createBundledTemplate bundledTemplateFiles
- -- match "404.html" $ 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
+ match notesPattern $ do
route cleanRoute
compile $ do
notes <- loadNoteLinks
- tocCtx <- getTocCtx $ listField "notes" defaultContext (return notes) <> defaultContext
- chaoDocCompiler
+ tocCtx <- getTocCtx cslPath (listField "notes" defaultContext (pure notes) <> defaultContext)
+ 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)
- `mappend` constField "title" "Notes"
- `mappend` defaultContext
+ listField "notes" defaultContext (pure notes)
+ <> constField "title" "Notes"
+ <> defaultContext
makeItem ""
>>= loadAndApplyTemplate "templates/notes.html" notesCtx
>>= loadAndApplyTemplate "templates/index.html" notesCtx
>>= relativizeUrls
>>= cleanIndexHtmls
- -- create ["archive.html"] $ do
- -- route cleanRoute
- -- compile $ do
- -- posts <- recentFirst =<< loadAll "posts/*"
- -- 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
+createBundledCss :: FilePath -> Rules ()
+createBundledCss relPath = create [fromFilePath relPath] $ do
+ route idRoute
+ compile bundledCssCompiler
- -- create ["draft.html"] $ do
- -- route cleanRoute
- -- compile $ do
- -- posts <- recentFirst =<< loadAll "posts/*"
- -- 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
+createBundledCopy :: FilePath -> Rules ()
+createBundledCopy relPath = create [fromFilePath relPath] $ do
+ route idRoute
+ compile bundledCopyCompiler
- -- match "index.html" $ do
- -- route idRoute
- -- compile $ do
- -- posts <- fmap (take 25) . recentFirst =<< loadAll "posts/*"
- -- let indexCtx =
- -- listField "posts" postCtx (return posts)
- -- `mappend` defaultContext
- -- getResourceBody
- -- >>= applyAsTemplate indexCtx
- -- >>= loadAndApplyTemplate "templates/index.html" indexCtx
- -- >>= relativizeUrls
- -- >>= cleanIndexHtmls
+createBundledTemplate :: FilePath -> Rules ()
+createBundledTemplate relPath =
+ create [fromFilePath relPath] $
+ compile bundledTemplateCompiler
- 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
--- create ["sitemap.xml"] $ do
--- route idRoute
--- compile $ do
--- posts <- recentFirst =<< loadAll "posts/*"
--- singlePages <- loadAll (fromList ["about.md"])
--- let pages = posts <> singlePages
--- sitemapCtx =
--- constField "root" root
--- <> listField "pages" postCtx (return pages) -- here
--- makeItem ""
--- >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
+bundledTextCompiler :: Compiler (Item String)
+bundledTextCompiler = do
+ assetPath <- bundledAssetPath
+ contents <- unsafeCompiler (readFile assetPath)
+ makeItem contents
+
+bundledCssCompiler :: Compiler (Item String)
+bundledCssCompiler = fmap compressCss <$> bundledTextCompiler
+
+bundledCopyCompiler :: Compiler (Item CopyFile)
+bundledCopyCompiler = do
+ 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 ctx = do
+getTocCtx :: FilePath -> Context a -> Compiler (Context a)
+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,
diff --git a/templates/head.html b/templates/head.html
index a85ea58..d4f6800 100644
--- a/templates/head.html
+++ b/templates/head.html
@@ -3,6 +3,7 @@
$title$
+
diff --git a/templates/index.html b/templates/index.html
index a899aff..3dc1cc0 100644
--- a/templates/index.html
+++ b/templates/index.html
@@ -7,6 +7,7 @@
+
@@ -31,4 +32,4 @@
-