rf/site.hs

{-# LANGUAGE OverloadedStrings #-}

import Data.Monoid ((<>))
import Data.List (sortBy,isSuffixOf)
import GHC.IO.Encoding
import Hakyll
import Hakyll.Favicon (faviconsRules, faviconsField)
import System.FilePath.Posix (takeBaseName,takeDirectory,(</>))

main :: IO ()
main = do 
   setLocaleEncoding utf8
   hakyll $ do
      faviconsRules "icons/favicon.svg"
      match "humans.txt" $ do
         route idRoute
         compile copyFileCompiler

      match "css/*" $ do
         route   idRoute
         compile compressCssCompiler

      match (fromList ["about.md", "contact.md"]) $ do
         route $ cleanRoute
         compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/default.html" ctx
            >>= relativizeUrls
            >>= cleanIndexUrls

      match "archive.md" $ do
         route $ cleanRoute
         compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/archive.html" ctx
            >>= relativizeUrls
            >>= cleanIndexUrls

         compile $ do
            posts <- recentFirst =<< loadAll "posts/*"
            let archiveCtx =
                  listField "posts" postCtx (return posts) <>
                  ctx
            pandocCompiler
               >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
               >>= loadAndApplyTemplate "templates/default.html" archiveCtx
               >>= relativizeUrls
               >>= cleanIndexUrls

      match "posts/*" $ do
         route $ cleanRoute
         compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/post.html"    postCtx
            >>= saveSnapshot "content"
            >>= loadAndApplyTemplate "templates/default.html" postCtx
            >>= relativizeUrls
            >>= cleanIndexUrls
            >>= cleanIndexHtmls

      match "index.html" $ do
         route idRoute
         compile $ do
            posts <- recentFirst =<< loadAll "posts/*"
            let indexCtx =
                  listField "posts" postCtx (return posts) <> ctx
            getResourceBody
               >>= applyAsTemplate indexCtx
               >>= loadAndApplyTemplate "templates/default.html" indexCtx
               >>= relativizeUrls
               >>= cleanIndexUrls
               >>= cleanIndexHtmls

      match "templates/*" $ compile templateBodyCompiler

      create ["atom.xml"] $ do
         route idRoute
         compile $ do
            let feedCtx = postCtx <>
                          bodyField "description"
            posts <- fmap (take 10) . recentFirst
               =<< loadAllSnapshots "posts/*" "content"
            renderAtom feedConfig feedCtx posts

      create ["rss.xml"] $ do
         route idRoute
         compile $ do
            let feedCtx = postCtx <>
                          bodyField "description"
            posts <- fmap (take 10) . recentFirst
               =<< loadAllSnapshots "posts/*" "content"
            renderRss feedConfig feedCtx posts

ctx :: Context String
ctx = defaultContext <>
      faviconsField

postCtx :: Context String
postCtx =
   (dateField "date" "%B %e, %Y") <> ctx

cleanRoute :: Routes
cleanRoute = customRoute createIndexRoute
   where
      createIndexRoute ident =
         takeDirectory p </> takeBaseName p </> "index.html"
            where p = toFilePath ident

cleanIndexUrls :: Item String -> Compiler (Item String)
cleanIndexUrls = return . fmap (withUrls cleanIndex)

cleanIndexHtmls :: Item String -> Compiler (Item String)
cleanIndexHtmls = return . fmap (replaceAll pattern replacement)
   where
      pattern = "/index.html"
      replacement = const "/"

cleanIndex :: String -> String
cleanIndex url
    | idx `isSuffixOf` url = take (length url - length idx) url
    | otherwise            = url
   where idx = "index.html"

feedConfig :: FeedConfiguration
feedConfig = FeedConfiguration {
      feedTitle = "Regular Flolloping"
   ,  feedDescription = "tA's Blog"
   ,  feedAuthorName = "Shaun Kerr"
   ,  feedAuthorEmail = "s@p7.co.nz"
   ,  feedRoot = "https://regularflolloping.com"
   }