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

site.hs: Format with default LSP formatter

Browse source
This commit is contained in:
Sanchayan Maity 2022-11-19 14:33:51 +05:30
parent 2490265685
commit 61f35bbb3a
1 changed files with 88 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

170
site.hs
View file

@ -1,116 +1,122 @@
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Data.Monoid (mappend)
import Hakyll import Data.Monoid (mappend)
import qualified GHC.IO.Encoding as E import qualified GHC.IO.Encoding as E
import Hakyll
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main = do
E.setLocaleEncoding E.utf8 E.setLocaleEncoding E.utf8
hakyllWith config $ do hakyllWith config $ do
match "images/*" $ do match "images/*" $ do
route idRoute route idRoute
compile copyFileCompiler compile copyFileCompiler
match "css/*" $ compile compressCssCompiler match "css/*" $ compile compressCssCompiler
create ["style.css"] $ do create ["style.css"] $ do
route idRoute route idRoute
compile $ do compile $ do
csses <- loadAll "css/*.css" csses <- loadAll "css/*.css"
makeItem $ unlines $ map itemBody csses makeItem $ unlines $ map itemBody csses
match (fromList ["about.markdown"]) $ do match (fromList ["about.markdown"]) $ do
route $ setExtension "html" route $ setExtension "html"
compile $ pandocCompiler compile $
>>= loadAndApplyTemplate "templates/default.html" defaultContext pandocCompiler
>>= relativizeUrls >>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
tags <- buildTags "posts/*" (fromCapture "tags/*.html") tags <- buildTags "posts/*" (fromCapture "tags/*.html")
match "posts/*" $ do match "posts/*" $ do
route $ setExtension "html" route $ setExtension "html"
compile $ pandocCompiler compile $
>>= loadAndApplyTemplate "templates/post.html" (postCtxWithTags tags) pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags) >>= loadAndApplyTemplate "templates/post.html" (postCtxWithTags tags)
>>= relativizeUrls >>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags)
>>= 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" (postCtxWithTags tags) (return posts) `mappend` listField "posts" (postCtxWithTags tags) (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
>>= relativizeUrls >>= relativizeUrls
match "index.html" $ do match "index.html" $ do
route idRoute route idRoute
compile $ do compile $ do
posts <- fmap (take 3) . recentFirst =<< loadAll "posts/*" posts <- fmap (take 3) . recentFirst =<< loadAll "posts/*"
let indexCtx = let indexCtx =
listField "posts" (postCtxWithTags tags) (return posts) `mappend` listField "posts" (postCtxWithTags tags) (return posts)
field "tags" (\_ -> renderTagList tags) `mappend` `mappend` field "tags" (\_ -> renderTagList tags)
constField "title" "Welcome" `mappend` `mappend` constField "title" "Welcome"
defaultContext `mappend` defaultContext
getResourceBody getResourceBody
>>= applyAsTemplate indexCtx >>= applyAsTemplate indexCtx
>>= loadAndApplyTemplate "templates/default.html" indexCtx >>= loadAndApplyTemplate "templates/default.html" indexCtx
>>= relativizeUrls >>= relativizeUrls
create ["sitemap.xml"] $ do create ["sitemap.xml"] $ do
route idRoute route idRoute
compile $ do compile $ do
posts <- recentFirst =<< loadAll "posts/*" posts <- recentFirst =<< loadAll "posts/*"
let sitemapCtx = let sitemapCtx =
constField "baseUrl" "sanchayanmaity.net" `mappend` constField "baseUrl" "sanchayanmaity.net"
constField "title" "Sitemap" `mappend` `mappend` constField "title" "Sitemap"
listField "posts" (postCtxWithTags tags) (return posts) `mappend` `mappend` listField "posts" (postCtxWithTags tags) (return posts)
postCtxWithTags tags `mappend` postCtxWithTags tags
makeItem "" makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx >>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
>>= cleanIndexHtmls >>= cleanIndexHtmls
match "templates/*" $ compile templateBodyCompiler match "templates/*" $ compile templateBodyCompiler
tagsRules tags $ \tag pattern -> do tagsRules tags $ \tag pattern -> 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 =
`mappend` listField "posts" (postCtxWithTags tags) (return posts) constField "title" title
`mappend` defaultContext `mappend` listField "posts" (postCtxWithTags tags) (return posts)
`mappend` 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
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
config :: Configuration config :: Configuration
config = defaultConfiguration { config =
destinationDirectory = "public" defaultConfiguration
} { destinationDirectory = "public"
}
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 `mappend` postCtx postCtxWithTags tags = tagsField "tags" tags `mappend` postCtx
cleanIndexHtmls :: Item String -> Compiler (Item String) cleanIndexHtmls :: Item String -> Compiler (Item String)
cleanIndexHtmls = return . fmap (replaceAll pattern replacement) cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
where where
pattern = "/index.html" pattern = "/index.html"
replacement :: String -> String replacement :: String -> String
replacement = const "/" replacement = const "/"