{-# 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 "&") 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 }