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           Hakyll
import           Text.Pandoc as Pandoc
import qualified Data.Text as T
import qualified System.Process  as Process
import           System.FilePath (replaceExtension, takeDirectory)
import           Data.Maybe (isJust)
import           Hakyll.Images ( loadImage
                                , scaleImageCompiler
                               )

--------------------------------------------------------------------------------
-- | Entry point
main :: IO ()
main = hakyllWith cfg $ do
    -- Resize images
    match "img/thumbnails/**.png" $ do
        route idRoute
        compile $ loadImage
            >>= scaleImageCompiler 140 140

    match "img/heads/**.png" $ do
        route idRoute
        compile $ loadImage
            >>= scaleImageCompiler 256 256

    match "img/large/**.png" $ do
        route idRoute
        compile $ loadImage
            >>= scaleImageCompiler 900 262

    -- copying stuff
    match ("fonts/*"
        .||. "img/*"
        .||. "img/*/**.png"
        .||. "css/*"
        .||. "js/*"
        .||. "reveal.js/dist/**"
        .||. "reveal.js/plugin/**"
        .||. "cours/prog_seq/slides/figs/*"
        .||. "cours/math_tech_info/figs/*"
        .||. "cours/math_tech_info/cours.pdf"
        .||. "cours/isc_physics/cours.pdf"
        .||. "cours/isc_physics/figs/*") $ do
      route idRoute
      compile $ copyFileCompiler

    -- Phys app posts
    match "cours/isc_physics/*.markdown" $ do
        route $ setExtension "html"
        compile $ pandocCrossrefNumberingCompiler
            >>= loadAndApplyTemplate "templates/class.html"    postCtx
            >>= relativizeUrls

    -- Phys app post list
    create ["phys_app.html"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll ("cours/isc_physics/*.markdown" .&&. hasNoVersion)
            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Physique appliquée" "cours/isc_physics/cours.pdf")
                >>= relativizeUrls

    -- Math Tech Info posts
    match "cours/math_tech_info/*.markdown" $ do
        route $ setExtension "html"
        compile $ pandocCrossrefNumberingCompiler
            >>= loadAndApplyTemplate "templates/class.html"    postCtx
            >>= relativizeUrls

    -- Math Tech Info posts in PDF. Producing the .pdf
    -- PDF produced but putting it into a list not...
    -- match "cours/math_tech_info/1_Rappel.markdown" $ version "pdf" $ do
    --     route   $ setExtension "pdf"
    --     compile $ do getResourceBody
    --         >>= readPandoc
    --         >>= writeXeTex
    --         >>= loadAndApplyTemplate "templates/default.latex" defaultContext
    --         >>= xelatex

    -- Math Tech Info post list
    create ["math_tech_info.html"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll ("cours/math_tech_info/*.markdown" .&&. hasNoVersion)
            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Mathématiques en technologie de l'information" "cours/math_tech_info/cours.pdf")
                >>= relativizeUrls

    -- Phys app posts
    match "cours/prog_seq/slides/*.markdown" $ do
        route $ setExtension "html"
        compile $ pandocRevealCompiler
            >>= loadAndApplyTemplate "templates/reveal.html" postCtx
            >>= relativizeUrls

    -- Phys app post list
    create ["prog_seq.html"] $ do
        route idRoute
        compile $ do
            posts <- recentFirst =<< loadAll "cours/prog_seq/slides/*.markdown"
            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" (courseCtx posts "Programmation séquentielle" "cours/isc_physics/cours.pdf")
                >>= relativizeUrls


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

    -- Read templates
    match "templates/*" $ compile templateCompiler

    -- Used to compile to PDF
    -- where
    --   writeXeTex :: Item Pandoc.Pandoc -> Compiler (Item String)
    --   writeXeTex = traverse $ \pandoc ->
    --       case Pandoc.runPure (Pandoc.writeLaTeX Pandoc.def pandoc) of
    --           Left err -> fail $ show err
    --           Right x  -> return (T.unpack x)

    

-- pages :: Rules ()
-- pages = do
--   match "pages/*" $ do
--     route $ setExtension "html"
--     compile $ getResourceBody
--       >>= loadAndApplyTemplate "templates/page.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 $ pandocCrossrefNumberingCompiler
--       >>= 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



-- 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


--------------------------------------------------------------------
-- 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 pdfurl =
  listField "posts" postCtx (return posts)
  `mappend` constField "title" title
  `mappend` constField "pdfurl" pdfurl
  `mappend` defaultContext

courseRevealCtx 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

--------------------------------------------------------------------
-- 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

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



pandocRevealCompiler :: Compiler (Item String)
pandocRevealCompiler = do 
    getResourceBody 
        >>= withItemBody (unixFilter "pandoc" ["-F"
                                            , "pandoc-numbering"
                                            , "-F"
                                            , "pandoc-crossref"
                                            , "-t"
                                            , "revealjs"
                                            , "-V"
                                            , "revealjs-url=./reveal.js"
                                            , "-V"
                                            , "theme=white"
                                            ])
        >>= readPandocWith defaultHakyllReaderOptions
        >>= return . writePandocWith pandocOptions

--------------------------------------------------------------------------------
-- | Hacky.
-- xelatex :: Item String -> Compiler (Item TmpFile)
-- xelatex item = do
--     TmpFile texPath <- newTmpFile "xelatex.tex"
--     let tmpDir  = takeDirectory texPath
--         pdfPath = replaceExtension texPath "pdf"

--     unsafeCompiler $ do
--         writeFile texPath $ itemBody item
--         _ <- Process.system $ unwords ["xelatex", "-halt-on-error",
--             "-output-directory", tmpDir, texPath, ">/dev/null", "2>&1"]
--         return ()

--     makeItem $ TmpFile pdfPath


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