From 06aa9fbc7b73bdc3b04bc9bf6ffc224f61198412 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Thu, 20 May 2010 23:54:38 +0200
Subject: Expose pandoc options (patch by JD Marble).

---
 src/Text/Hakyll/HakyllMonad.hs   | 18 ++++++++++++------
 src/Text/Hakyll/Internal/Page.hs | 41 ++++++++++++++--------------------------
 2 files changed, 26 insertions(+), 33 deletions(-)

(limited to 'src/Text/Hakyll')

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.
-- 
cgit v1.2.3