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

{-# 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
    }