mirror of
http://101.35.51.105:3000/congyu/Hakysidian.git
synced 2026-04-27 21:40:50 +08:00
Revert "Rename package to hakysidian; add CLI and assets"
This reverts commit 3d2c5a8852.
This commit is contained in:
@@ -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
|
||||
+150
-382
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user