nani.wtf/static-site-generator/Main.hs

289 lines
7.3 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (forM_)
import Data.Maybe (fromMaybe)
import Hakyll
import Text.Pandoc
( Extension (Ext_fenced_code_attributes, Ext_footnotes, Ext_gfm_auto_identifiers, Ext_implicit_header_references, Ext_smart),
Extensions,
Pandoc,
ReaderOptions,
WriterOptions (writerHighlightStyle),
extensionsFromList,
githubMarkdownExtensions,
readerExtensions,
writerExtensions,
)
import Text.Pandoc.Highlighting (Style, breezeDark, styleToCss)
import Debug.Trace
import Data.Map (mapKeys)
import Text.Pandoc.Walk ( walk, walkM )
-- ---------
import Formats.Gogen
import Formats.Posts
import Util.Hakyll.Routes
import Util.Hakyll.Context
import Util.Hash
import Preprocessing.LogoLinks
import Preprocessing.Graphviz
--------------------------------------------------------------------------------
-- CONFIG
root :: String
root =
"https://www.nani.wtf/"
siteName :: String
siteName =
"Nani"
config :: Configuration
config =
defaultConfiguration
{ destinationDirectory = "dist"
, ignoreFile = const False
, previewHost = "127.0.0.1"
, previewPort = 8000
, providerDirectory = "www"
, storeDirectory = "/tmp/nani-wtf-hakyll/store"
, tmpDirectory = "/tmp/nani-wtf-hakyll/tmp"
}
--------------------------------------------------------------------------------
-- BUILD
applyDefaultTemplate :: Context String -> Item String -> Compiler (Item String)
applyDefaultTemplate ctx item = do
head <- itemBody <$> loadAndApplyTemplate "templates/head.html" ctx item
navbar <- itemBody <$> loadAndApplyTemplate "templates/navbar.html" ctx item
let ctx' = constField "head" head
<> constField "navbar" navbar
<> ctx
loadAndApplyTemplate "templates/default.html" ctx' item
main :: IO ()
main = hakyllWith config $ do
fileHashes <- preprocess (mapKeys (fromFilePath . drop 4 . toFilePath) <$> mkFileHashes "www/posts")
forM_
[ "CNAME"
, "favicon.ico"
, "_config.yml"
, "images/**"
, "fonts/*"
]
$ \f -> match f $ do
route idRoute
compile copyFileCompiler
match "robots.txt" $ do
route (constRoute "public/robots.txt")
compile copyFileCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match "posts/*" $ do
let ctx = constField "type" "article" <> postCtx
route $ postRoute fileHashes
compile $
getResourceBody
>>= replaceLogoLinks
>>= pandocRendererCustom
>>= loadAndApplyTemplate "templates/blogpost.html" ctx
>>= applyDefaultTemplate ctx
match "gogen/**" $ do
let ctx =
constField "type" "article"
<> constField "root" root
<> constField "siteName" siteName
<> gogenCtx
route $ setExtension ".html"
compile $ do
pandocCompilerCustom
>>= loadAndApplyTemplate "templates/gogen.html" ctx
>>= applyDefaultTemplate ctx
match "*debug.md" $ do
let ctx = constField "type" "article" <> postCtx
route $ constRoute "debug.html"
compile $
getResourceBody
>>= replaceLogoLinks
>>= pandocRendererCustom
>>= loadAndApplyTemplate "templates/blogpost.html" ctx
>>= applyDefaultTemplate ctx
match "index.html" $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
gogen <- loadAll "gogen/**"
let indexCtx =
listField "posts" postCtx (return posts)
<> listField "gogen" gogenCtx (return gogen)
<> constField "root" root
<> constField "siteName" siteName
<> defaultContext
getResourceBody
>>= applyAsTemplate indexCtx
>>= applyDefaultTemplate indexCtx
match "templates/*" $
compile templateBodyCompiler
create ["public/sitemap.xml"] $ do
route idRoute
compile $ do
posts <- recentFirst =<< loadAll "posts/*"
let pages = posts
sitemapCtx =
constField "root" root
<> constField "siteName" siteName
<> listField "pages" postCtx (return pages)
makeItem ("" :: String)
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
create ["public/rss.xml"] $ do
route idRoute
compile (feedCompiler renderRss)
create ["public/atom.xml"] $ do
route idRoute
compile (feedCompiler renderAtom)
create ["css/code.css"] $ do
route idRoute
compile (makeStyle pandocHighlightStyle)
--------------------------------------------------------------------------------
-- COMPILER HELPERS
makeStyle :: Style -> Compiler (Item String)
makeStyle =
makeItem . compressCss . styleToCss
--------------------------------------------------------------------------------
-- CONTEXT
feedCtx :: Context String
feedCtx =
titleCtx
<> postCtx
<> bodyField "description"
postCtx :: Context String
postCtx =
constField "root" root
<> defaultConstField "lang" "en"
<> constField "author" "h7x4"
<> constField "siteName" siteName
<> dateField "date" "%Y-%m-%d"
<> defaultContext
titleCtx :: Context String
titleCtx =
field "title" updatedTitle
--------------------------------------------------------------------------------
-- TITLE HELPERS
replaceAmp :: String -> String
replaceAmp =
replaceAll "&" (const "&amp;")
replaceTitleAmp :: Metadata -> String
replaceTitleAmp =
replaceAmp . safeTitle
safeTitle :: Metadata -> String
safeTitle =
fromMaybe "no title" . lookupString "title"
updatedTitle :: Item a -> Compiler String
updatedTitle =
fmap replaceTitleAmp . getMetadata . itemIdentifier
--------------------------------------------------------------------------------
-- PANDOC
pandocCompilerCustom :: Compiler (Item String)
pandocCompilerCustom =
pandocCompilerWith pandocReaderOpts pandocWriterOpts
pandocRendererCustom :: Item String -> Compiler (Item String)
pandocRendererCustom =
renderPandocWithTransformM pandocReaderOpts pandocWriterOpts transform
where
transform :: Pandoc -> Compiler Pandoc
transform = unsafeCompiler . walkM codeBlock
pandocExtensionsCustom :: Extensions
pandocExtensionsCustom =
githubMarkdownExtensions
<> extensionsFromList
[ Ext_fenced_code_attributes
, Ext_gfm_auto_identifiers
, Ext_implicit_header_references
, Ext_smart
, Ext_footnotes
]
pandocReaderOpts :: ReaderOptions
pandocReaderOpts =
defaultHakyllReaderOptions
{ readerExtensions = pandocExtensionsCustom
}
pandocWriterOpts :: WriterOptions
pandocWriterOpts =
defaultHakyllWriterOptions
{ writerExtensions = pandocExtensionsCustom
, writerHighlightStyle = Just pandocHighlightStyle
}
pandocHighlightStyle :: Style
pandocHighlightStyle =
breezeDark -- https://hackage.haskell.org/package/pandoc/docs/Text-Pandoc-Highlighting.html
-- FEEDS
type FeedRenderer =
FeedConfiguration ->
Context String ->
[Item String] ->
Compiler (Item String)
feedCompiler :: FeedRenderer -> Compiler (Item String)
feedCompiler renderer =
renderer feedConfiguration feedCtx
=<< recentFirst
=<< loadAllSnapshots "posts/*" "content"
feedConfiguration :: FeedConfiguration
feedConfiguration =
FeedConfiguration
{ feedTitle = "www.nani.wtf"
, feedDescription = "???"
, feedAuthorName = "h7x4"
, feedAuthorEmail = "h7x4@protonmail.com"
, feedRoot = root
}