mirror of
http://101.35.51.105:3000/congyu/Hakysidian.git
synced 2026-04-27 21:40:50 +08:00
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.
This commit is contained in:
+16
-3
@@ -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
|
||||
|
||||
@@ -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,18 +8,18 @@ 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:
|
||||
|
||||
+20
-33
@@ -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
|
||||
|
||||
+406
-167
@@ -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,
|
||||
|
||||
@@ -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" />
|
||||
|
||||
@@ -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" />
|
||||
|
||||
Reference in New Issue
Block a user