diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Hakyll.hs | 32 | ||||
| -rw-r--r-- | src/Text/Hakyll/HakyllMonad.hs | 18 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Page.hs | 41 |
3 files changed, 52 insertions, 39 deletions
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. |