dimitri/blog
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Format site.hs with ormolu

Browse source
This commit is contained in:
Dimitri Lozeve 2024-01-13 18:57:29 +01:00
parent 0c47bd7ad1
commit 0800c06188
1 changed files with 80 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

155
site.hs
View file

@ -1,39 +1,37 @@
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Monoid (mappend) import Data.Monoid (mappend)
import Hakyll
import Text.Pandoc import Hakyll.Core.Compiler.Internal (compilerAsk, compilerProvider)
import Text.Pandoc.Options import Hakyll.Core.Provider (resourceFilePath)
import Text.Pandoc.Highlighting import Text.Pandoc
import Text.Pandoc.SideNote import Text.Pandoc.Highlighting
import Text.Pandoc.Options
import Hakyll import Text.Pandoc.SideNote
import Hakyll.Core.Compiler.Internal (compilerProvider, compilerAsk)
import Hakyll.Core.Provider (resourceFilePath)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = hakyll $ do main = hakyll $ do
match "images/**" $ do match "images/**" $ do
route idRoute route idRoute
compile copyFileCompiler compile copyFileCompiler
match "favicon.ico" $ do match "favicon.ico" $ do
route idRoute route idRoute
compile copyFileCompiler compile copyFileCompiler
match "files/*" $ do match "files/*" $ do
route idRoute route idRoute
compile copyFileCompiler compile copyFileCompiler
match "css/*.css" $ do match "css/*.css" $ do
route idRoute route idRoute
compile compressCssCompiler compile compressCssCompiler
match "css/et-book/**" $ do match "css/et-book/**" $ do
route idRoute route idRoute
compile copyFileCompiler compile copyFileCompiler
match "bib/*" $ compile biblioCompiler match "bib/*" $ compile biblioCompiler
@ -46,44 +44,47 @@ main = hakyll $ do
let title = "Posts tagged \"" ++ tag ++ "\"" let title = "Posts tagged \"" ++ tag ++ "\""
route idRoute route idRoute
compile $ do compile $ do
posts <- recentFirst =<< loadAll pattern posts <- recentFirst =<< loadAll pattern
let ctx = constField "title" title let ctx =
<> listField "posts" (postCtxWithTags tags) (return posts) constField "title" title
<> defaultContext <> listField "posts" (postCtxWithTags tags) (return posts)
<> defaultContext
makeItem "" makeItem ""
>>= loadAndApplyTemplate "templates/tag.html" ctx >>= loadAndApplyTemplate "templates/tag.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx >>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls >>= relativizeUrls
match "posts/*" $ do match "posts/*" $ do
route $ setExtension "html" route $ setExtension "html"
compile $ do compile $
underlying <- getUnderlying do
toc <- getMetadataField underlying "toc" underlying <- getUnderlying
customPandocCompiler (toc == Just "yes" || toc == Just "true") toc <- getMetadataField underlying "toc"
>>= return . fmap demoteHeaders customPandocCompiler (toc == Just "yes" || toc == Just "true")
>>= loadAndApplyTemplate "templates/post.html" (postCtxWithTags tags) >>= return . fmap demoteHeaders
>>= saveSnapshot "content" >>= loadAndApplyTemplate "templates/post.html" (postCtxWithTags tags)
>>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags) >>= saveSnapshot "content"
>>= relativizeUrls >>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags)
>>= relativizeUrls
match (fromList ["contact.org", "cv.org", "skills.org", "projects.org"]) $ do match (fromList ["contact.org", "cv.org", "skills.org", "projects.org"]) $ do
route $ setExtension "html" route $ setExtension "html"
compile $ customPandocCompiler False compile $
>>= return . fmap demoteHeaders customPandocCompiler False
>>= loadAndApplyTemplate "templates/post.html" postCtx >>= return . fmap demoteHeaders
>>= loadAndApplyTemplate "templates/default.html" defaultContext >>= loadAndApplyTemplate "templates/post.html" postCtx
>>= relativizeUrls >>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
create ["archive.html"] $ do create ["archive.html"] $ do
route idRoute route idRoute
compile $ do compile $ do
posts <- recentFirst =<< loadAll "posts/*" posts <- recentFirst =<< loadAll "posts/*"
let archiveCtx = let archiveCtx =
listField "posts" postCtx (return posts) `mappend` listField "posts" postCtx (return posts)
constField "title" "Archives" `mappend` `mappend` constField "title" "Archives"
defaultContext `mappend` defaultContext
makeItem "" makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
>>= loadAndApplyTemplate "templates/default.html" archiveCtx >>= loadAndApplyTemplate "templates/default.html" archiveCtx
@ -102,8 +103,8 @@ main = hakyll $ do
compile $ do compile $ do
posts <- fmap (take 10) $ recentFirst =<< loadAll "posts/*" posts <- fmap (take 10) $ recentFirst =<< loadAll "posts/*"
let indexCtx = let indexCtx =
listField "posts" postCtx (return posts) `mappend` listField "posts" postCtx (return posts)
defaultContext `mappend` defaultContext
getResourceBody getResourceBody
>>= applyAsTemplate indexCtx >>= applyAsTemplate indexCtx
>>= loadAndApplyTemplate "templates/default.html" indexCtx >>= loadAndApplyTemplate "templates/default.html" indexCtx
@ -111,22 +112,21 @@ main = hakyll $ do
match "templates/*" $ compile templateBodyCompiler match "templates/*" $ compile templateBodyCompiler
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
feedConfiguration :: FeedConfiguration feedConfiguration :: FeedConfiguration
feedConfiguration = feedConfiguration =
FeedConfiguration FeedConfiguration
{ feedTitle = "Dimitri Lozeve's Blog" { feedTitle = "Dimitri Lozeve's Blog",
, feedDescription = "Recent posts" feedDescription = "Recent posts",
, feedAuthorName = "Dimitri Lozeve" feedAuthorName = "Dimitri Lozeve",
, feedAuthorEmail = "dimitri+web@lozeve.com" feedAuthorEmail = "dimitri+web@lozeve.com",
, feedRoot = "https://www.lozeve.com" feedRoot = "https://www.lozeve.com"
} }
postCtx :: Context String postCtx :: Context String
postCtx = postCtx =
dateField "date" "%B %e, %Y" `mappend` dateField "date" "%B %e, %Y"
defaultContext `mappend` defaultContext
postCtxWithTags :: Tags -> Context String postCtxWithTags :: Tags -> Context String
postCtxWithTags tags = tagsField "tags" tags <> postCtx postCtxWithTags tags = tagsField "tags" tags <> postCtx
@ -140,36 +140,41 @@ customPandocCompiler withTOC =
let customExtensions = extensionsFromList [Ext_latex_macros] let customExtensions = extensionsFromList [Ext_latex_macros]
defaultExtensions = writerExtensions defaultHakyllWriterOptions defaultExtensions = writerExtensions defaultHakyllWriterOptions
newExtensions = defaultExtensions `mappend` customExtensions newExtensions = defaultExtensions `mappend` customExtensions
writerOptions = defaultHakyllWriterOptions writerOptions =
{ writerExtensions = newExtensions defaultHakyllWriterOptions
, writerHTMLMathMethod = MathJax "" { writerExtensions = newExtensions,
} writerHTMLMathMethod = MathJax ""
}
-- below copied from https://www.gwern.net/hakyll.hs -- below copied from https://www.gwern.net/hakyll.hs
-- below copied from https://github.com/jaspervdj/hakyll/blob/e8ed369edaae1808dffcc22d1c8fb1df7880e065/web/site.hs#L73 because god knows I don't know what this type bullshit is either: -- below copied from https://github.com/jaspervdj/hakyll/blob/e8ed369edaae1808dffcc22d1c8fb1df7880e065/web/site.hs#L73 because god knows I don't know what this type bullshit is either:
-- "When did it get so hard to compile a string to a Pandoc template?" -- "When did it get so hard to compile a string to a Pandoc template?"
tocTemplate = tocTemplate =
either error id $ either (error . show) id $ either error id $
runPure $ runWithDefaultPartials $ either (error . show) id $
compileTemplate "" "<div id=\"toc\"><h1>Table of Contents</h1>$toc$</div>\n$body$" runPure $
writerOptionsWithTOC = writerOptions runWithDefaultPartials $
{ writerTableOfContents = True compileTemplate "" "<div id=\"toc\"><h1>Table of Contents</h1>$toc$</div>\n$body$"
, writerTOCDepth = 2 writerOptionsWithTOC =
, writerTemplate = Just tocTemplate--"<h1>Table of Contents</h1>$toc$\n$body$" writerOptions
} { writerTableOfContents = True,
writerTOCDepth = 2,
writerTemplate = Just tocTemplate -- "<h1>Table of Contents</h1>$toc$\n$body$"
}
readerOptions = defaultHakyllReaderOptions readerOptions = defaultHakyllReaderOptions
in do in do
csl <- load $ fromFilePath "csl/chicago-author-date.csl" csl <- load $ fromFilePath "csl/chicago-author-date.csl"
bib <- load $ fromFilePath "bib/bibliography.bib" bib <- load $ fromFilePath "bib/bibliography.bib"
writePandocWith (if withTOC then writerOptionsWithTOC else writerOptions) <$> writePandocWith (if withTOC then writerOptionsWithTOC else writerOptions)
(getResourceBody >>= readPandocBiblio readerOptions csl bib >>= traverse (return . usingSideNotes)) <$> (getResourceBody >>= readPandocBiblio readerOptions csl bib >>= traverse (return . usingSideNotes))
type FeedRenderer = FeedConfiguration type FeedRenderer =
-> Context String FeedConfiguration ->
-> [Item String] Context String ->
-> Compiler (Item String) [Item String] ->
Compiler (Item String)
feedCompiler :: FeedRenderer -> Compiler (Item String) feedCompiler :: FeedRenderer -> Compiler (Item String)
feedCompiler renderer = feedCompiler renderer =
renderer feedConfiguration feedCtx renderer feedConfiguration feedCtx
=<< fmap (take 10) . recentFirst =<< fmap (take 10) . recentFirst
=<< loadAllSnapshots "posts/*" "content" =<< loadAllSnapshots "posts/*" "content"