Expose pandoc options (patch by JD Marble).

4 files changed, 54 insertions, 40 deletions

diff --git a/examples/hakyll/about.markdown b/examples/hakyll/about.markdown
index b58485b..2ecc6d5 100644
--- a/examples/hakyll/about.markdown
+++ b/examples/hakyll/about.markdown
@@ -26,4 +26,5 @@ you will have to license your code under a GPL-compatible license.
 ## Authors
 
 Hakyll was originally written by [Jasper Van der Jeugt](http://jaspervdj.be). It
-also received contributions from [seschwar](http://github.com/seschwar).
+also received contributions from [seschwar](http://github.com/seschwar) and
+[JD Marble](http://github.com/jdmarble/).
diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index 2545014..8cc1653 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -21,19 +21,39 @@ import System.Environment (getArgs, getProgName)
 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 import System.Time (getClockTime)
 
+import Text.Pandoc
+
 import Network.Hakyll.SimpleServer (simpleServer)
 import Text.Hakyll.HakyllMonad
 import Text.Hakyll.File
 
+-- | The default reader options for pandoc parsing.
+defaultPandocParserState :: ParserState
+defaultPandocParserState = defaultParserState
+    { -- The following option causes pandoc to read smart typography, a nice
+      -- and free bonus.
+      stateSmart = True
+    }
+
+-- | The default writer options for pandoc rendering.
+defaultPandocWriterOptions :: WriterOptions
+defaultPandocWriterOptions = defaultWriterOptions
+    { -- This option causes literate haskell to be written using '>' marks in
+      -- html, which I think is a good default.
+      writerLiterateHaskell = True
+    }
+
 -- | The default hakyll configuration.
 defaultHakyllConfiguration :: HakyllConfiguration
 defaultHakyllConfiguration = HakyllConfiguration
-    { absoluteUrl       = ""
-    , additionalContext = M.empty
-    , siteDirectory     = "_site"
-    , cacheDirectory    = "_cache"
-    , enableIndexUrl    = False
-    , previewPollDelay  = 1000000
+    { absoluteUrl         = ""
+    , additionalContext   = M.empty
+    , siteDirectory       = "_site"
+    , cacheDirectory      = "_cache"
+    , enableIndexUrl      = False
+    , previewPollDelay    = 1000000
+    , pandocParserState   = defaultPandocParserState
+    , pandocWriterOptions = defaultPandocWriterOptions
     }
 
 -- | Main function to run Hakyll with the default configuration. The
diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs
index 4a9e696..fbfe5ae 100644
--- a/src/Text/Hakyll/HakyllMonad.hs
+++ b/src/Text/Hakyll/HakyllMonad.hs
@@ -10,6 +10,8 @@ import Control.Monad.Reader (ReaderT, ask)
 import Control.Monad (liftM)
 import qualified Data.Map as M
 
+import Text.Pandoc (ParserState, WriterOptions)
+
 import Text.Hakyll.Context (Context)
 
 -- | Our custom monad stack.
@@ -18,18 +20,22 @@ type Hakyll = ReaderT HakyllConfiguration IO
 -- | Hakyll global configuration type.
 data HakyllConfiguration = HakyllConfiguration
     { -- | Absolute URL of the site.
-      absoluteUrl       :: String
+      absoluteUrl         :: String
     , -- | An additional context to use when rendering. This additional context
       --   is used globally.
-      additionalContext :: Context
+      additionalContext   :: Context
     , -- | Directory where the site is placed.
-      siteDirectory     :: FilePath
+      siteDirectory       :: FilePath
     , -- | Directory for cache files.
-      cacheDirectory    :: FilePath
+      cacheDirectory      :: FilePath
     , -- | Enable index links.
-      enableIndexUrl    :: Bool
+      enableIndexUrl      :: Bool
     , -- | Delay between polls in preview mode.
-      previewPollDelay  :: Int
+      previewPollDelay    :: Int
+    , -- | Pandoc parsing options
+      pandocParserState   :: ParserState
+    , -- | Pandoc writer options
+      pandocWriterOptions :: WriterOptions
     }
 
 -- | Simplified @ask@ function for the Hakyll monad stack.
diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index d3d0ec1..115bc09 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -1,5 +1,5 @@
 -- | A module for dealing with @Page@s. This module is mostly internally used.
-module Text.Hakyll.Internal.Page 
+module Text.Hakyll.Internal.Page
     ( readPage
     ) where
 
@@ -20,28 +20,15 @@ import Text.Hakyll.Util (trim)
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Internal.FileType
 
--- | The default reader options for pandoc parsing.
-readerOptions :: ParserState
-readerOptions = defaultParserState
-    { -- The following option causes pandoc to read smart typography, a nice
-      -- and free bonus.
-      stateSmart = True
-    }
-
--- | The default writer options for pandoc rendering.
-writerOptions :: WriterOptions
-writerOptions = defaultWriterOptions
-    { -- This option causes literate haskell to be written using '>' marks in
-      -- html, which I think is a good default.
-      writerLiterateHaskell = True
-    }
-
 -- | Get a render function for a given extension.
-getRenderFunction :: FileType -> (String -> String)
-getRenderFunction Html     = id
-getRenderFunction Text     = id
-getRenderFunction fileType = writeHtmlString writerOptions
-                           . readFunction fileType (readOptions fileType)
+getRenderFunction :: FileType -> Hakyll (String -> String)
+getRenderFunction Html     = return id
+getRenderFunction Text     = return id
+getRenderFunction fileType = do
+    parserState <- askHakyll pandocParserState
+    writerOptions <- askHakyll pandocWriterOptions
+    return $ writeHtmlString writerOptions
+           . readFunction fileType (readOptions parserState fileType)
   where
     readFunction ReStructuredText        = readRST
     readFunction LaTeX                   = readLaTeX
@@ -49,9 +36,9 @@ getRenderFunction fileType = writeHtmlString writerOptions
     readFunction LiterateHaskellMarkdown = readMarkdown
     readFunction t                       = error $ "Cannot render " ++ show t
 
-    readOptions LiterateHaskellMarkdown =
-        readerOptions { stateLiterateHaskell = True }
-    readOptions _                       = readerOptions
+    readOptions options LiterateHaskellMarkdown = options
+        { stateLiterateHaskell = True }
+    readOptions options _                       = options
 
 -- | Split a page into sections.
 splitAtDelimiters :: [String] -> State (Maybe String) [[String]]
@@ -103,8 +90,8 @@ readSection renderFunction isFirst ls
 --   has a @.markdown@ extension, it will be rendered using pandoc.
 readPageFromFile :: FilePath -> Hakyll Context
 readPageFromFile path = do
-    let renderFunction = getRenderFunction $ getFileType path
-        sectionFunctions = map (readSection renderFunction)
+    renderFunction <- getRenderFunction $ getFileType path
+    let sectionFunctions = map (readSection renderFunction)
                                (True : repeat False)
 
     -- Read file.