pdorg_site/site.hs

--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import           Data.Monoid (mappend)
import           Hakyll
import qualified Data.Set                   as S
import           Text.Pandoc


--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
  match "images/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "images/*/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "assets/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "scripts/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "talks/*/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "talks/*/*/*" $ do
    route   idRoute
    compile copyFileCompiler

  match "talks/*/*/*/*" $ do
    route   idRoute
    compile copyFileCompiler


  match "stuff/zombie_protagonist/Zombie.swf" $ do
    route   idRoute
    compile copyFileCompiler

  match "stuff/zombie_protagonist/library/mp3/*.mp3" $ do
    route   idRoute
    compile copyFileCompiler


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

  match "resume_jmelesky.pdf" $ do
    route   idRoute
    compile copyFileCompiler


  match "stuff/*.md" $ do
    route   $ setExtension "html"
    compile $ siteCompiler
      >>= loadAndApplyTemplate "templates/default.html" defaultContext
      >>= relativizeUrls

  match "stuff/*/*.md" $ do
    route   $ setExtension "html"
    compile $ siteCompiler
      >>= loadAndApplyTemplate "templates/default.html" defaultContext
      >>= relativizeUrls

  match "*.md" $ do
    route   $ setExtension "html"
    compile $ siteCompiler
      >>= loadAndApplyTemplate "templates/default.html" defaultContext
      >>= relativizeUrls

  tags <- buildTags "posts/*.md" (fromCapture "tags/*.html")

  tagsRules tags $ \tag pattern -> do
    let title = "Posts tagged \"" ++ tag ++ "\""
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll pattern
      let ctx = constField "title" title
            `mappend` listField "posts" postCtx (return posts)
            `mappend` defaultContext

      makeItem ""
        >>= loadAndApplyTemplate "templates/tag.html" ctx
        >>= loadAndApplyTemplate "templates/default.html" ctx
        >>= relativizeUrls

  match "posts/*.md" $ do
    route $ setExtension "html"
    compile $ siteCompiler
      >>= loadAndApplyTemplate "templates/post.html"    (postCtxWithTags tags)
      >>= saveSnapshot "post_content"
      >>= loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags)
      >>= relativizeUrls

  create ["archive.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/*.md"
      let archiveCtx =
            listField "posts" postCtx (return posts) `mappend`
            constField "title" "Archives"            `mappend`
            defaultContext

      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
        >>= loadAndApplyTemplate "templates/default.html" archiveCtx
        >>= relativizeUrls

  create ["index.html"] $ do
    route idRoute
    compile $ do
      post <- fmap head . recentFirst =<< loadAllSnapshots "posts/*.md" "post_content"
      loadAndApplyTemplate "templates/default.html" (postCtxWithTags tags) post
      >>= relativizeUrls
      >>= changeIdentifier "index.html"

  match "templates/*" $ compile templateBodyCompiler


--------------------------------------------------------------------------------
postCtx :: Context String
postCtx =
  dateField "date" "%B %e, %Y" `mappend`
  defaultContext

postCtxWithTags :: Tags -> Context String
postCtxWithTags tags = tagsField "tags" tags `mappend` postCtx

changeIdentifier :: Identifier -> Item a -> Compiler (Item a)
changeIdentifier idt item = return (itemSetIdentifier idt item)

itemSetIdentifier :: Identifier -> Item a -> Item a
itemSetIdentifier x (Item _ i) = Item x i

siteCompiler :: Compiler (Item String)
siteCompiler =
  let addExtensions = [Ext_tex_math_dollars, Ext_tex_math_double_backslash,
                        Ext_latex_macros, Ext_footnotes, Ext_inline_notes]
      wExtensions = foldr S.insert (writerExtensions defaultHakyllWriterOptions) addExtensions
      rExtensions = foldr S.insert (readerExtensions defaultHakyllReaderOptions) addExtensions
      siteWriterOptions = defaultHakyllWriterOptions {
        writerExtensions = wExtensions,
        writerHTMLMathMethod = MathJax ""
        }
      siteReaderOptions = defaultHakyllReaderOptions {
        readerExtensions = rExtensions
        }
  in pandocCompilerWith siteReaderOptions siteWriterOptions