src: format

Signed-off-by: Amneesh Singh <natto@weirdnatto.in>
master
Amneesh Singh 2023-08-26 20:45:10 +05:30
parent 7cb266782d
commit ba247f88d4
Signed by: natto1784
GPG Key ID: 007257B05FCC86A8
1 changed files with 164 additions and 164 deletions

View File

@ -6,240 +6,240 @@ import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Hakyll
import System.Environment (getEnv)
import System.FilePath (replaceDirectory, replaceExtension, takeDirectory)
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Process as Process
import Text.Pandoc
( WriterOptions
( writerHighlightStyle,
import Text.Pandoc (
WriterOptions (
writerHighlightStyle,
writerNumberSections,
writerTOCDepth,
writerTableOfContents,
writerTemplate
),
)
),
)
import qualified Text.Pandoc as Pandoc
import Text.Pandoc.Templates (Template, compileTemplate)
import System.Environment (getEnv)
import System.IO.Unsafe (unsafePerformIO)
--------------------------------------------------------------------------------
main :: IO ()
main = hakyllWith config $ do
let individualPatterns = fromList ["about.org", "contact.org", "links.org", "documents/cv.org"]
let copyPatterns = fromList ["images/**", "fonts/*", "documents/*"]
let individualPatterns = fromList ["about.org", "contact.org", "links.org", "documents/cv.org"]
let copyPatterns = fromList ["images/**", "fonts/*", "documents/*"]
match "images/**" $ do
route idRoute
compile copyFileCompiler
match "images/**" $ do
route idRoute
compile copyFileCompiler
match "fonts/*" $ do
route idRoute
compile copyFileCompiler
match "fonts/*" $ do
route idRoute
compile copyFileCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match "*pdf" $ do
route idRoute
match "*pdf" $ do
route idRoute
match individualPatterns $ do
route $ setExtension "html"
compile $
pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultCtx
>>= relativizeUrls
match individualPatterns $ do
route $ setExtension "html"
compile $
pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultCtx
>>= relativizeUrls
-- kindly stolen from https://github.com/jaspervdj/jaspervdj/blob/b2a9a34cd2195c6e216b922e152c42266dded99d/src/Main.hs#L163-L169
-- also see helper functions writeXetex and xelatex
match "documents/cv.org" $
version "pdf" $ do
route $ setExtension "pdf"
compile $
getResourceBody
>>= readPandoc
>>= writeXeTex
>>= loadAndApplyTemplate "templates/cv.tex" defaultCtx
>>= xelatex
-- kindly stolen from https://github.com/jaspervdj/jaspervdj/blob/b2a9a34cd2195c6e216b922e152c42266dded99d/src/Main.hs#L163-L169
-- also see helper functions writeXetex and xelatex
match "documents/cv.org" $
version "pdf" $ do
route $ setExtension "pdf"
compile $
getResourceBody
>>= readPandoc
>>= writeXeTex
>>= loadAndApplyTemplate "templates/cv.tex" defaultCtx
>>= xelatex
tags <- buildTags "posts/*" (fromCapture "archive/tags/*.html")
tags <- buildTags "posts/*" (fromCapture "archive/tags/*.html")
tagsRules tags $ \tag pattern -> do
let title = "Posts tagged \"" ++ tag ++ "\""
route idRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let tagCtx =
constField "title" title
<> constField "tag" tag
<> listField "posts" (postCtx tags) (return posts)
<> defaultCtx
tagsRules tags $ \tag pattern -> do
let title = "Posts tagged \"" ++ tag ++ "\""
route idRoute
compile $ do
posts <- recentFirst =<< loadAll pattern
let tagCtx =
constField "title" title
<> constField "tag" tag
<> listField "posts" (postCtx tags) (return posts)
<> defaultCtx
makeItem ""
>>= loadAndApplyTemplate "templates/tag.html" tagCtx
>>= loadAndApplyTemplate "templates/default.html" tagCtx
>>= relativizeUrls
makeItem ""
>>= loadAndApplyTemplate "templates/tag.html" tagCtx
>>= loadAndApplyTemplate "templates/default.html" tagCtx
>>= relativizeUrls
match "posts/*org" $ do
route $ setExtension "html"
compile $ do
identifier <- getUnderlying
toc <- getMetadataField identifier "enabletoc"
numbering <- getMetadataField identifier "enablenumbering"
let writerOptions' = maybe defaultHakyllWriterOptions (const $ writerOptions $ isJust numbering) toc
pandocCompilerWith defaultHakyllReaderOptions writerOptions'
>>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/post.html" (postCtx tags)
>>= loadAndApplyTemplate "templates/default.html" (postCtx tags)
>>= relativizeUrls
match "posts/*org" $ do
route $ setExtension "html"
compile $ do
identifier <- getUnderlying
toc <- getMetadataField identifier "enabletoc"
numbering <- getMetadataField identifier "enablenumbering"
let writerOptions' = maybe defaultHakyllWriterOptions (const $ writerOptions $ isJust numbering) toc
pandocCompilerWith defaultHakyllReaderOptions writerOptions'
>>= saveSnapshot "content"
>>= loadAndApplyTemplate "templates/post.html" (postCtx tags)
>>= loadAndApplyTemplate "templates/default.html" (postCtx tags)
>>= relativizeUrls
create ["archive.html"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let archiveCtx =
listField "posts" (postCtx tags) (return posts)
<> constField "title" "Archives"
<> field "tags" (\_ -> renderTagList tags)
<> defaultCtx
create ["archive.html"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let archiveCtx =
listField "posts" (postCtx tags) (return posts)
<> constField "title" "Archives"
<> field "tags" (\_ -> renderTagList tags)
<> defaultCtx
makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx
>>= loadAndApplyTemplate "templates/default.html" archiveCtx
>>= relativizeUrls
makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx
>>= loadAndApplyTemplate "templates/default.html" archiveCtx
>>= relativizeUrls
match "index.html" $ do
route idRoute
compile $ do
let indexCtx = defaultCtx
match "index.html" $ do
route idRoute
compile $ do
let indexCtx = defaultCtx
getResourceBody
>>= applyAsTemplate indexCtx
>>= loadAndApplyTemplate "templates/default.html" indexCtx
>>= relativizeUrls
getResourceBody
>>= applyAsTemplate indexCtx
>>= loadAndApplyTemplate "templates/default.html" indexCtx
>>= relativizeUrls
create ["rss.xml"] $ do
route idRoute
compile $ do
let feedCtx = postCtx tags <> bodyField "description"
posts <- fmap (take 10) . recentFirst =<< loadAllSnapshots "posts/*" "content"
renderRss rssFeedConfiguration feedCtx posts
create ["rss.xml"] $ do
route idRoute
compile $ do
let feedCtx = postCtx tags <> bodyField "description"
posts <- fmap (take 10) . recentFirst =<< loadAllSnapshots "posts/*" "content"
renderRss rssFeedConfiguration feedCtx posts
-- https://robertwpearce.com/hakyll-pt-2-generating-a-sitemap-xml-file.html
create ["sitemap.xml"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
individualPages <- loadAll individualPatterns
let pages = posts <> individualPages
sitemapCtx =
listField "pages" (postCtx tags) (return pages)
<> defaultCtx
makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
-- https://robertwpearce.com/hakyll-pt-2-generating-a-sitemap-xml-file.html
create ["sitemap.xml"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
individualPages <- loadAll individualPatterns
let pages = posts <> individualPages
sitemapCtx =
listField "pages" (postCtx tags) (return pages)
<> defaultCtx
makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
match "templates/*" $ compile templateBodyCompiler
match "templates/*" $ compile templateBodyCompiler
where
-- https://github.com/jaspervdj/jaspervdj/blob/b2a9a34cd2195c6e216b922e152c42266dded99d/src/Main.hs#L214-L218
writeXeTex :: Item Pandoc.Pandoc -> Compiler (Item String)
writeXeTex = traverse $ \pandoc ->
case Pandoc.runPure (Pandoc.writeLaTeX Pandoc.def pandoc) of
Left err -> fail $ show err
Right x -> return (T.unpack x)
case Pandoc.runPure (Pandoc.writeLaTeX Pandoc.def pandoc) of
Left err -> fail $ show err
Right x -> return (T.unpack x)
-- https://github.com/jaspervdj/jaspervdj/blob/b2a9a34cd2195c6e216b922e152c42266dded99d/src/Main.hs#L280-L292
-- but even more hacky
xelatex :: Item String -> Compiler (Item TmpFile)
xelatex item = do
TmpFile texPath <- newTmpFile "xelatex.tex"
let tmpDir = takeDirectory texPath
pdfPath = replaceExtension texPath "pdf"
TmpFile texPath <- newTmpFile "xelatex.tex"
let tmpDir = takeDirectory texPath
pdfPath = replaceExtension texPath "pdf"
unsafeCompiler $ do
writeFile texPath $ itemBody item
let x = itemBody item
_ <-
Process.system $
unwords
[ "xelatex",
"-halt-on-error",
"-output-directory",
tmpDir,
texPath,
">/dev/null",
"2>&1"
]
return ()
unsafeCompiler $ do
writeFile texPath $ itemBody item
let x = itemBody item
_ <-
Process.system $
unwords
[ "xelatex"
, "-halt-on-error"
, "-output-directory"
, tmpDir
, texPath
, ">/dev/null"
, "2>&1"
]
return ()
makeItem $ TmpFile pdfPath
makeItem $ TmpFile pdfPath
rssFeedConfiguration :: FeedConfiguration
rssFeedConfiguration =
FeedConfiguration
{ feedTitle = "nattopages",
feedDescription = "Pages by natto",
feedAuthorName = "Amneesh Singh",
feedAuthorEmail = "natto@weirdnatto.in",
feedRoot = "https://weirdnatto.in"
}
FeedConfiguration
{ feedTitle = "nattopages"
, feedDescription = "Pages by natto"
, feedAuthorName = "Amneesh Singh"
, feedAuthorEmail = "natto@weirdnatto.in"
, feedRoot = "https://weirdnatto.in"
}
config :: Configuration
config =
defaultConfiguration
{ deployCommand = "rsync --checksum -ave 'ssh -p" ++ sshTargetPort ++"' _site/* " ++ sshTarget,
previewPort = 3333
}
defaultConfiguration
{ deployCommand = "rsync --checksum -ave 'ssh -p" ++ sshTargetPort ++ "' _site/* " ++ sshTarget
, previewPort = 3333
}
where
{-# NOINLINE sshTarget#-}
{-# NOINLINE sshTarget #-}
sshTarget = unsafePerformIO $ getEnv "SSHTARGET"
{-# NOINLINE sshTargetPort#-}
{-# NOINLINE sshTargetPort #-}
sshTargetPort = unsafePerformIO $ getEnv "SSHTARGETPORT"
postCtx :: Tags -> Context String
postCtx tags =
tagsField "tags" tags
-- <> teaserFieldWithSeparator "((.tease.))" "teaser" "content"
<> dateField "date" "%B %e, %Y"
<> dateField "altdate" "%Y-%m-%d"
<> teaserField "teaser" "content"
<> defaultCtx
tagsField "tags" tags
-- <> teaserFieldWithSeparator "((.tease.))" "teaser" "content"
<> dateField "date" "%B %e, %Y"
<> dateField "altdate" "%Y-%m-%d"
<> teaserField "teaser" "content"
<> defaultCtx
defaultCtx :: Context String
defaultCtx =
listField "subdomains" subCtx (return subdomains)
<> domainCtx
<> defaultContext
listField "subdomains" subCtx (return subdomains)
<> domainCtx
<> defaultContext
where
domain :: String
domain = "weirdnatto.in"
subCtx :: Context String
subCtx =
field "name" (return . itemBody)
<> domainCtx
field "name" (return . itemBody)
<> domainCtx
domainCtx :: Context String
domainCtx = constField "domain" domain
subdomains :: [Item String]
subdomains = map mkItem ["git", "radio", "f"]
where
mkItem :: a -> Item a
mkItem a = Item {itemIdentifier = "subdomain", itemBody = a}
mkItem a = Item{itemIdentifier = "subdomain", itemBody = a}
writerOptions :: Bool -> WriterOptions
writerOptions withNumbering =
defaultHakyllWriterOptions
{ writerNumberSections = withNumbering,
writerTableOfContents = True,
writerTOCDepth = 2,
writerTemplate = Just tocTemplate
}
defaultHakyllWriterOptions
{ writerNumberSections = withNumbering
, writerTableOfContents = True
, writerTOCDepth = 2
, writerTemplate = Just tocTemplate
}
tocTemplate :: Text.Pandoc.Templates.Template Text
tocTemplate =
either error id . runIdentity . compileTemplate "" $
T.unlines
[ "<div class=\"toc\"><div class=\"toc-header\">Table of Contents</div>",
"$toc$",
"</div>",
"$body$"
]
either error id . runIdentity . compileTemplate "" $
T.unlines
[ "<div class=\"toc\"><div class=\"toc-header\">Table of Contents</div>"
, "$toc$"
, "</div>"
, "$body$"
]