Main.hs

{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Stephen Diehl 2013
-- License   :  MIT
-- Maintainer:  stephen.m.diehl@gmail.com
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------

module Main where

{-# LANGUAGE OverloadedStrings #-}
import           Data.Monoid (mappend)
import           Hakyll
import           Text.Pandoc
import           qualified Data.Map as M
import           Data.Maybe (isJust)
import           Text.Pandoc.Highlighting
import           Hakyll.Images ( loadImage
                                , scaleImageCompiler
                               )

--------------------------------------------------------------------
-- Contexts
--------------------------------------------------------------------

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

mathCtx :: Context String
mathCtx = field "mathjax" $ \item -> do
  metadata <- getMetadata $ itemIdentifier item
  return ""
  return $ if isJust $ lookupString "mathjax" metadata
           then "<script type=\"text/javascript\" src=\"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_HTML\"></script>"
           else ""

courseCtx posts title =
  listField "posts" postCtx (return posts)
  `mappend` constField "title" title
  `mappend` defaultContext
            
researchCtx posts =
  listField "posts" postCtx (return posts)
  `mappend` constField "title" "Research projects"
  `mappend` defaultContext

bachelorCtx posts =
  listField "posts" postCtx (return posts)
  `mappend` constField "title" "Bachelor projects"
  `mappend` defaultContext

indexCtx posts =
  listField "posts" postCtx (return posts)
  `mappend` constField "title" "Home"
  `mappend` defaultContext

--------------------------------------------------------------------
-- Rules
--------------------------------------------------------------------

static :: Rules ()
static = do
  match ("fonts/*"
       .||. "img/*"
       .||. "img/*/**.png"
       .||. "css/*"
       .||. "js/*"
       .||. "cours/math_tech_info/figs/*"
       .||. "cours/isc_physics/figs/*") $ do
    route idRoute
    compile $ copyFileCompiler

resizeThumbnails :: Rules ()
resizeThumbnails = do
  match "img/thumbnails/**.png" $ do
      route idRoute
      compile $ loadImage
        >>= scaleImageCompiler 140 140

resizeHeads :: Rules ()
resizeHeads = do
  match "img/heads/**.png" $ do
      route idRoute
      compile $ loadImage
        >>= scaleImageCompiler 256 256

resizeLarge :: Rules ()
resizeLarge = do
  match "img/large/**.png" $ do
      route idRoute
      compile $ loadImage
        >>= scaleImageCompiler 900 500

pages :: Rules ()
pages = do
  match "pages/*" $ do
    route $ setExtension "html"
    compile $ getResourceBody
      >>= loadAndApplyTemplate "templates/page.html"    postCtx
      >>= relativizeUrls

posts :: Rules ()
posts = do
  match "posts/*" $ do
    route $ setExtension "html"
    -- compile $ myPandocCompiler
    compile $ bibtexCompiler
      >>= loadAndApplyTemplate "templates/post.html"    postCtx
      >>= relativizeUrls

research :: Rules ()
research = do
  create ["research_projects.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/research/*"
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" (researchCtx posts)
        >>= relativizeUrls

bachelor :: Rules ()
bachelor = do
  create ["bachelor_projects.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/bachelor/*"
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" (bachelorCtx posts)
        >>= relativizeUrls

cours_conc :: Rules ()
cours_conc = do
  match "cours/*" $ do
    route $ setExtension "html"
    -- compile $ myPandocCompiler
    compile $ bibtexCompiler
      >>= loadAndApplyTemplate "templates/post.html"    postCtx
      >>= relativizeUrls

conc :: Rules ()
conc = do
  create ["prog_conc.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "cours/*"
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Programmation concurrente")
        >>= relativizeUrls

cours_mti :: Rules ()
cours_mti = do
  match "cours/math_tech_info/*.markdown" $ do
    route $ setExtension "html"
    -- compile $ myPandocCompiler
    compile $ bibtexCompiler
      >>= loadAndApplyTemplate "templates/class.html"    postCtx
      >>= relativizeUrls

mti :: Rules ()
mti = do
  create ["math_tech_info.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "cours/math_tech_info/*"
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Mathématiques en technologie de l'information")
        >>= relativizeUrls

cours_phys_app :: Rules ()
cours_phys_app = do
  match "cours/isc_physics/*.markdown" $ do
    route $ setExtension "html"
    -- compile $ myPandocCompiler
    compile $ bibtexCompiler
      >>= loadAndApplyTemplate "templates/class.html"    postCtx
      >>= relativizeUrls

phys_app :: Rules ()
phys_app = do
  create ["phys_app.html"] $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "cours/isc_physics/*"
      makeItem ""
        >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Physique appliquée")
        >>= relativizeUrls

index :: Rules ()
index = do
  match "index.html" $ do
    route idRoute
    compile $ do
      posts <- recentFirst =<< loadAll "posts/*"
      getResourceBody
        >>= applyAsTemplate (indexCtx posts)
        >>= relativizeUrls

templates :: Rules ()
templates = match "templates/*" $ compile templateCompiler

--------------------------------------------------------------------
-- Configuration
--------------------------------------------------------------------

myPandocCompiler :: Compiler (Item String)
myPandocCompiler = pandocCompilerWith defaultHakyllReaderOptions pandocOptions 

pandocOptions :: WriterOptions
pandocOptions = defaultHakyllWriterOptions
    { 
        writerExtensions = defaultPandocExtensions
        , writerHTMLMathMethod = MathJax ""
        , writerNumberSections = True 
        , writerTableOfContents = True
    }

-- Pandoc extensions used by the myPandocCompiler
defaultPandocExtensions :: Extensions
defaultPandocExtensions = 
    let extensions = [ 
            -- Pandoc Extensions: http://pandoc.org/MANUAL.html#extensions
            -- Math extensions
              Ext_tex_math_dollars
            , Ext_tex_math_double_backslash
            , Ext_latex_macros
                -- Code extensions
            , Ext_fenced_code_blocks
            , Ext_backtick_code_blocks
            , Ext_fenced_code_attributes
            , Ext_inline_code_attributes        -- Inline code attributes (e.g. `<$>`{.haskell})
                -- Markdown extensions
            , Ext_implicit_header_references    -- We also allow implicit header references (instead of inserting <a> tags)
            , Ext_definition_lists              -- Definition lists based on PHP Markdown
            , Ext_yaml_metadata_block           -- Allow metadata to be speficied by YAML syntax
            , Ext_superscript                   -- Superscripts (2^10^ is 1024)
            , Ext_subscript                     -- Subscripts (H~2~O is water)
            , Ext_footnotes                     -- Footnotes ([^1]: Here is a footnote)
            ]
        defaultExtensions = writerExtensions defaultHakyllWriterOptions

    in foldr enableExtension defaultExtensions extensions

bibtexCompiler :: Compiler (Item String)
bibtexCompiler = do 
    getResourceBody 
        >>= withItemBody (unixFilter "pandoc" ["-F"
                                            , "pandoc-numbering"
                                            , "-F"
                                            , "pandoc-crossref"
                                            , "-t"
                                            , "markdown"
                                            ])
        >>= readPandocWith defaultHakyllReaderOptions
        >>= return . writePandocWith pandocOptions


cfg :: Configuration
cfg = defaultConfiguration

main :: IO ()
main = hakyllWith cfg $ do
  pages
  posts
  cours_conc
  conc
  cours_mti
  mti
  cours_phys_app
  phys_app
  research
  bachelor
  index
  templates
  resizeThumbnails
  resizeLarge
  resizeHeads
  static