From 1789c75f18996513b1bb6594e23bdd012c6fbb63 Mon Sep 17 00:00:00 2001 From: Yu Cong Date: Tue, 24 Mar 2026 19:58:26 +0800 Subject: [PATCH] Revert "Rename package to hakysidian; add CLI and assets" This reverts commit 3d2c5a885281c804ce3fe3fdd98705fadcfd49c6. --- hakysidian.cabal => hakyll-blog.cabal | 17 +- src/site.hs | 532 ++++++++------------------ 2 files changed, 154 insertions(+), 395 deletions(-) rename hakysidian.cabal => hakyll-blog.cabal (76%) diff --git a/hakysidian.cabal b/hakyll-blog.cabal similarity index 76% rename from hakysidian.cabal rename to hakyll-blog.cabal index a25232c..87b2bb9 100644 --- a/hakysidian.cabal +++ b/hakyll-blog.cabal @@ -1,20 +1,13 @@ -name: hakysidian +name: hakyll-blog version: 0.1.0.0 build-type: Simple -cabal-version: 2.0 -data-files: - templates/*.html - css/*.css - fonts/*.woff2 - bib_style.csl - favicon.ico +cabal-version: >= 1.10 executable site hs-source-dirs: src main-is: site.hs - autogen-modules: Paths_hakysidian - other-modules: ChaoDoc, SideNoteHTML, Pangu, Paths_hakysidian + other-modules: ChaoDoc, SideNoteHTML, Pangu build-depends: base >= 4.18 , hakyll >= 4.15 , mtl >= 2.2.2 @@ -24,12 +17,10 @@ executable site , tagsoup , text , containers - , directory -- , process -- , regex-compat , array , filepath - , temporary -- , ghc-syntax-highlighter -- , blaze-html >= 0.9 , megaparsec @@ -43,4 +34,4 @@ executable site -Wno-unsafe -Wno-prepositive-qualified-module -O2 -threaded -rtsopts -with-rtsopts=-N - default-language: Haskell2010 + default-language: Haskell2010 \ No newline at end of file diff --git a/src/site.hs b/src/site.hs index 3d693bc..214b994 100644 --- a/src/site.hs +++ b/src/site.hs @@ -2,32 +2,13 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE ViewPatterns #-} import ChaoDoc -import Control.Monad (filterM, forM_, unless) -import Data.Kind (Type) -import Data.List (sortOn, stripPrefix) +import Data.List (sortOn) import qualified Data.Text as T import Hakyll -import qualified Paths_hakysidian as Paths -import System.Directory - ( copyFile, - createDirectoryIfMissing, - createDirectoryLink, - createFileLink, - doesDirectoryExist, - doesFileExist, - listDirectory, - makeAbsolute, - withCurrentDirectory - ) -import System.Environment (getArgs, withArgs) -import System.Exit (die, exitSuccess) import System.FilePath -import System.IO.Error (tryIOError) -import System.IO.Temp (withSystemTempDirectory) import Text.Pandoc -------------------------------------------------------------------------------- @@ -35,371 +16,40 @@ import Text.Pandoc cleanRoute :: Routes cleanRoute = customRoute createIndexRoute where - createIndexRoute :: Identifier -> FilePath - createIndexRoute ident - | dir == "." = base "index.html" - | otherwise = dir base "index.html" + createIndexRoute ident = takeDirectory p takeBaseName p "index.html" where p = toFilePath ident - dir = takeDirectory p - base = takeBaseName p cleanIndexHtmls :: Item String -> Compiler (Item String) cleanIndexHtmls = return . fmap (replaceAll pattern replacement) where - pattern :: String - pattern = "/index.html" - - replacement :: String -> String - replacement = const "/" - -notePattern :: Pattern -notePattern = - fromGlob "*.md" - .&&. complement (fromGlob "math-macros.md") - .&&. complement (fromGlob "index.md") - -reservedMarkdownFiles :: [FilePath] -reservedMarkdownFiles = ["index.md", "math-macros.md"] + pattern :: String = "/index.html" + replacement :: String -> String = const "/" loadNoteLinks :: Compiler [Item String] loadNoteLinks = do - noteIds <- sortOn toFilePath <$> getMatches notePattern + noteIds <- sortOn toFilePath <$> getMatches "notes/*" pure [Item noteId "" | noteId <- noteIds] -------------------------------------------------------------------------------- -type CliOptions :: Type -data CliOptions = CliOptions - { cliContentDir :: Maybe FilePath, - cliOutputDir :: Maybe FilePath, - cliReferenceBib :: Maybe FilePath, - cliMathMacros :: Maybe FilePath, - cliCssDir :: Maybe FilePath, - cliFontsDir :: Maybe FilePath, - cliTemplatesDir :: Maybe FilePath, - cliBibStyle :: Maybe FilePath, - cliFavicon :: Maybe FilePath - } - -type ResolvedOptions :: Type -data ResolvedOptions = ResolvedOptions - { resolvedContentDir :: FilePath, - resolvedOutputDir :: FilePath, - resolvedStoreDir :: FilePath, - resolvedTmpDir :: FilePath, - resolvedReferenceBib :: FilePath, - resolvedMathMacros :: FilePath, - resolvedImagesDir :: Maybe FilePath, - resolvedCssDir :: FilePath, - resolvedFontsDir :: FilePath, - resolvedTemplatesDir :: FilePath, - resolvedBibStyle :: FilePath, - resolvedFavicon :: FilePath - } - -type ParseResult :: Type -data ParseResult - = Parsed CliOptions [String] - | ShowHelp - -defaultCliOptions :: CliOptions -defaultCliOptions = - CliOptions - { cliContentDir = Nothing, - cliOutputDir = Nothing, - cliReferenceBib = Nothing, - cliMathMacros = Nothing, - cliCssDir = Nothing, - cliFontsDir = Nothing, - cliTemplatesDir = Nothing, - cliBibStyle = Nothing, - cliFavicon = Nothing - } - -helpText :: String -helpText = - unlines - [ "Hakysidian", - "", - "Usage:", - " site [options] [build|watch|clean|rebuild|preview ...]", - "", - "The content directory should contain top-level markdown files,", - "an optional images/ folder, plus reference.bib and math-macros.md.", - "", - "Options:", - " --content-dir PATH Folder containing markdown files.", - " --output-dir PATH Destination for generated HTML. Default: CONTENT/_site", - " --reference-bib PATH Bibliography file. Default: CONTENT/reference.bib", - " --math-macros PATH Math macros file. Default: CONTENT/math-macros.md", - " --css-dir PATH Shared CSS directory. Default: packaged asset directory", - " --fonts-dir PATH Shared fonts directory. Default: packaged asset directory", - " --templates-dir PATH Shared templates directory. Default: packaged asset directory", - " --bib-style PATH CSL file. Default: packaged bib_style.csl", - " --favicon PATH Favicon file. Default: packaged favicon.ico", - " --help Show this help text" - ] - -parseCliArgs :: [String] -> Either String ParseResult -parseCliArgs = go defaultCliOptions [] - where - go :: CliOptions -> [String] -> [String] -> Either String ParseResult - go options passthrough = \case - [] -> Right (Parsed options (reverse passthrough)) - "--" : rest -> Right (Parsed options (reverse passthrough ++ rest)) - "--help" : _ -> Right ShowHelp - "-h" : _ -> Right ShowHelp - arg : rest - | Just value <- stripPrefix "--content-dir=" arg -> - go options {cliContentDir = Just value} passthrough rest - | Just value <- stripPrefix "--output-dir=" arg -> - go options {cliOutputDir = Just value} passthrough rest - | Just value <- stripPrefix "--reference-bib=" arg -> - go options {cliReferenceBib = Just value} passthrough rest - | Just value <- stripPrefix "--ref=" arg -> - go options {cliReferenceBib = Just value} passthrough rest - | Just value <- stripPrefix "--math-macros=" arg -> - go options {cliMathMacros = Just value} passthrough rest - | Just value <- stripPrefix "--css-dir=" arg -> - go options {cliCssDir = Just value} passthrough rest - | Just value <- stripPrefix "--fonts-dir=" arg -> - go options {cliFontsDir = Just value} passthrough rest - | Just value <- stripPrefix "--templates-dir=" arg -> - go options {cliTemplatesDir = Just value} passthrough rest - | Just value <- stripPrefix "--bib-style=" arg -> - go options {cliBibStyle = Just value} passthrough rest - | Just value <- stripPrefix "--favicon=" arg -> - go options {cliFavicon = Just value} passthrough rest - | arg == "--content-dir" -> - setPathOption "--content-dir" cliContentDir (\x y -> x {cliContentDir = Just y}) options passthrough rest - | arg == "--output-dir" -> - setPathOption "--output-dir" cliOutputDir (\x y -> x {cliOutputDir = Just y}) options passthrough rest - | arg == "--reference-bib" -> - setPathOption "--reference-bib" cliReferenceBib (\x y -> x {cliReferenceBib = Just y}) options passthrough rest - | arg == "--ref" -> - setPathOption "--ref" cliReferenceBib (\x y -> x {cliReferenceBib = Just y}) options passthrough rest - | arg == "--math-macros" -> - setPathOption "--math-macros" cliMathMacros (\x y -> x {cliMathMacros = Just y}) options passthrough rest - | arg == "--css-dir" -> - setPathOption "--css-dir" cliCssDir (\x y -> x {cliCssDir = Just y}) options passthrough rest - | arg == "--fonts-dir" -> - setPathOption "--fonts-dir" cliFontsDir (\x y -> x {cliFontsDir = Just y}) options passthrough rest - | arg == "--templates-dir" -> - setPathOption "--templates-dir" cliTemplatesDir (\x y -> x {cliTemplatesDir = Just y}) options passthrough rest - | arg == "--bib-style" -> - setPathOption "--bib-style" cliBibStyle (\x y -> x {cliBibStyle = Just y}) options passthrough rest - | arg == "--favicon" -> - setPathOption "--favicon" cliFavicon (\x y -> x {cliFavicon = Just y}) options passthrough rest - | otherwise -> - go options (arg : passthrough) rest - - setPathOption :: - String -> - (CliOptions -> Maybe FilePath) -> - (CliOptions -> FilePath -> CliOptions) -> - CliOptions -> - [String] -> - [String] -> - Either String ParseResult - setPathOption optionName getter setter options passthrough = \case - [] -> Left ("Missing value for " ++ optionName) - value : rest - | null value -> Left ("Missing value for " ++ optionName) - | getter options == Nothing -> - go (setter options value) passthrough rest - | otherwise -> - go (setter options value) passthrough rest - -resolveCliOptions :: CliOptions -> IO ResolvedOptions -resolveCliOptions options = do - contentDir <- makeAbsolute (maybe "." id (cliContentDir options)) - validateDirectoryExists "content directory" contentDir - - let outputDir0 = maybe (contentDir "_site") id (cliOutputDir options) - referenceBib0 = maybe (contentDir "reference.bib") id (cliReferenceBib options) - mathMacros0 = maybe (contentDir "math-macros.md") id (cliMathMacros options) - storeDir0 = contentDir ".hakysidian-cache" - tmpDir0 = contentDir ".hakysidian-tmp" - - outputDir <- makeAbsolute outputDir0 - referenceBib <- makeAbsolute referenceBib0 - mathMacros <- makeAbsolute mathMacros0 - storeDir <- makeAbsolute storeDir0 - tmpDir <- makeAbsolute tmpDir0 - - validateFileExists "reference bibliography" referenceBib - validateFileExists "math macros" mathMacros - - imagesDir <- resolveOptionalDirectory (contentDir "images") - cssDir <- resolveDirectoryOption "css directory" (cliCssDir options) defaultCssDir - fontsDir <- resolveDirectoryOption "fonts directory" (cliFontsDir options) defaultFontsDir - templatesDir <- resolveDirectoryOption "templates directory" (cliTemplatesDir options) defaultTemplatesDir - bibStyle <- resolveFileOption "CSL file" (cliBibStyle options) defaultBibStyle - favicon <- resolveFileOption "favicon" (cliFavicon options) defaultFavicon - - pure - ResolvedOptions - { resolvedContentDir = contentDir, - resolvedOutputDir = outputDir, - resolvedStoreDir = storeDir, - resolvedTmpDir = tmpDir, - resolvedReferenceBib = referenceBib, - resolvedMathMacros = mathMacros, - resolvedImagesDir = imagesDir, - resolvedCssDir = cssDir, - resolvedFontsDir = fontsDir, - resolvedTemplatesDir = templatesDir, - resolvedBibStyle = bibStyle, - resolvedFavicon = favicon - } - -defaultCssDir :: IO FilePath -defaultCssDir = takeDirectory <$> resolvePackagedFile ("css" "default.css") - -defaultFontsDir :: IO FilePath -defaultFontsDir = takeDirectory <$> resolvePackagedFile ("fonts" "IosevkaCustom-Regular.woff2") - -defaultTemplatesDir :: IO FilePath -defaultTemplatesDir = takeDirectory <$> resolvePackagedFile ("templates" "head.html") - -defaultBibStyle :: IO FilePath -defaultBibStyle = resolvePackagedFile "bib_style.csl" - -defaultFavicon :: IO FilePath -defaultFavicon = resolvePackagedFile "favicon.ico" - -resolvePackagedFile :: FilePath -> IO FilePath -resolvePackagedFile relativePath = do - installedPath <- Paths.getDataFileName relativePath - installedExists <- doesFileExist installedPath - if installedExists - then pure installedPath - else makeAbsolute relativePath - -resolveDirectoryOption :: - String -> - Maybe FilePath -> - IO FilePath -> - IO FilePath -resolveDirectoryOption label maybePath defaultAction = do - path0 <- maybe defaultAction pure maybePath - path <- makeAbsolute path0 - validateDirectoryExists label path - pure path - -resolveFileOption :: - String -> - Maybe FilePath -> - IO FilePath -> - IO FilePath -resolveFileOption label maybePath defaultAction = do - path0 <- maybe defaultAction pure maybePath - path <- makeAbsolute path0 - validateFileExists label path - pure path - -resolveOptionalDirectory :: FilePath -> IO (Maybe FilePath) -resolveOptionalDirectory path0 = do - path <- makeAbsolute path0 - exists <- doesDirectoryExist path - pure if exists then Just path else Nothing - -validateDirectoryExists :: String -> FilePath -> IO () -validateDirectoryExists label path = do - exists <- doesDirectoryExist path - unless exists $ - die ("Missing " ++ label ++ ": " ++ path) - -validateFileExists :: String -> FilePath -> IO () -validateFileExists label path = do - exists <- doesFileExist path - unless exists $ - die ("Missing " ++ label ++ ": " ++ path) - -findMarkdownSources :: FilePath -> IO [FilePath] -findMarkdownSources contentDir = do - entries <- listDirectory contentDir - let candidatePaths = sortOn takeFileName (map (contentDir ) entries) - files <- filterM doesFileExist candidatePaths - pure - [ path - | path <- files, - let fileName = takeFileName path, - takeExtension fileName == ".md", - fileName `notElem` reservedMarkdownFiles - ] - -prepareStageRoot :: ResolvedOptions -> FilePath -> IO () -prepareStageRoot options stageRoot = do - createDirectoryIfMissing True stageRoot - - markdownFiles <- findMarkdownSources (resolvedContentDir options) - forM_ markdownFiles \path -> - linkOrCopyFile path (stageRoot takeFileName path) - - forM_ (resolvedImagesDir options) \path -> - linkOrCopyDirectory path (stageRoot "images") - - linkOrCopyFile (resolvedReferenceBib options) (stageRoot "reference.bib") - linkOrCopyFile (resolvedMathMacros options) (stageRoot "math-macros.md") - linkOrCopyDirectory (resolvedCssDir options) (stageRoot "css") - linkOrCopyDirectory (resolvedFontsDir options) (stageRoot "fonts") - linkOrCopyDirectory (resolvedTemplatesDir options) (stageRoot "templates") - linkOrCopyFile (resolvedBibStyle options) (stageRoot "bib_style.csl") - linkOrCopyFile (resolvedFavicon options) (stageRoot "favicon.ico") - -linkOrCopyFile :: FilePath -> FilePath -> IO () -linkOrCopyFile source destination = do - createDirectoryIfMissing True (takeDirectory destination) - result <- tryIOError (createFileLink source destination) - case result of - Right () -> pure () - Left _ -> copyFile source destination - -linkOrCopyDirectory :: FilePath -> FilePath -> IO () -linkOrCopyDirectory source destination = do - createDirectoryIfMissing True (takeDirectory destination) - result <- tryIOError (createDirectoryLink source destination) - case result of - Right () -> pure () - Left _ -> copyDirectoryRecursive source destination - -copyDirectoryRecursive :: FilePath -> FilePath -> IO () -copyDirectoryRecursive source destination = do - createDirectoryIfMissing True destination - entries <- listDirectory source - forM_ entries \entry -> do - let srcPath = source entry - dstPath = destination entry - isDirectory <- doesDirectoryExist srcPath - if isDirectory - then copyDirectoryRecursive srcPath dstPath - else copyFile srcPath dstPath - --------------------------------------------------------------------------------- - -config :: ResolvedOptions -> Configuration -config options = +config :: Configuration +config = defaultConfiguration - { destinationDirectory = resolvedOutputDir options, - storeDirectory = resolvedStoreDir options, - tmpDirectory = resolvedTmpDir options, - providerDirectory = ".", - ignoreFile = \path -> + { ignoreFile = \path -> ignoreFile defaultConfiguration path || ".git" `elem` splitDirectories (normalise path) } -siteRules :: Rules () -siteRules = do +main :: IO () +main = hakyllWith config $ do match "images/**" $ do route idRoute compile copyFileCompiler match "math-macros.md" $ compile getResourceBody - match "fonts/**" $ do + match "fonts/*.woff2" $ do route idRoute compile copyFileCompiler @@ -407,11 +57,55 @@ siteRules = do route idRoute compile copyFileCompiler - match "css/**" $ do + -- match "404.html" $ do + -- route cleanRoute + -- compile copyFileCompiler + + match "css/*" $ do route idRoute compile compressCssCompiler - match notePattern $ do + -- 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 @@ -419,7 +113,6 @@ siteRules = do chaoDocCompiler >>= loadAndApplyTemplate "templates/note.html" tocCtx >>= relativizeUrls - >>= cleanIndexHtmls create ["index.html"] $ do route idRoute @@ -435,28 +128,103 @@ siteRules = do >>= 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 + + -- 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 + + -- 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 + match "templates/*" $ compile templateBodyCompiler -main :: IO () -main = do - rawArgs <- getArgs - parseResult <- - case parseCliArgs rawArgs of - Left err -> die err - Right result -> pure result - case parseResult of - ShowHelp -> putStrLn helpText >> exitSuccess - Parsed cliOptions hakyllArgs -> do - resolved <- resolveCliOptions cliOptions - createDirectoryIfMissing True (resolvedStoreDir resolved) - createDirectoryIfMissing True (resolvedTmpDir resolved) - withSystemTempDirectory "hakysidian-stage" \stageRoot -> do - prepareStageRoot resolved stageRoot - withCurrentDirectory stageRoot $ - withArgs hakyllArgs $ - hakyllWith (config resolved) siteRules +-- 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 -------------------------------------------------------------------------------- + +-- 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