From 9d99eda221cb67cb80c5dbd0dfbf3635cfd7cadc Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Mon, 4 Oct 2010 17:34:32 +0200
Subject: Provide an arrow-based interface to Pandoc module

---
 src/Text/Hakyll/Pandoc.hs | 39 +++++++++++++++++++--------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

diff --git a/src/Text/Hakyll/Pandoc.hs b/src/Text/Hakyll/Pandoc.hs
index dcd7392..c0dec77 100644
--- a/src/Text/Hakyll/Pandoc.hs
+++ b/src/Text/Hakyll/Pandoc.hs
@@ -7,7 +7,7 @@ module Text.Hakyll.Pandoc
 
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
-import Control.Arrow (second, (>>>), arr)
+import Control.Arrow (second, (>>>), arr, (&&&))
 
 import Text.Pandoc
 
@@ -19,15 +19,15 @@ import Text.Hakyll.Context
 
 -- | Get a render function for a given extension.
 --
-getRenderFunction :: FileType -> Hakyll (String -> String)
-getRenderFunction Html = return id
-getRenderFunction Text = return id
-getRenderFunction UnknownFileType = return id
-getRenderFunction fileType = do
-    parserState <- askHakyll pandocParserState
-    writerOptions <- askHakyll pandocWriterOptions
-    return $ writeHtmlString writerOptions
-           . readFunction fileType (readOptions parserState fileType)
+getRenderFunction :: HakyllAction FileType (String -> String)
+getRenderFunction = createHakyllAction $ \fileType -> case fileType of
+    Html -> return id
+    Text -> return id
+    UnknownFileType -> return id
+    _ -> do parserState <- askHakyll pandocParserState
+            writerOptions <- askHakyll pandocWriterOptions
+            return $ writeHtmlString writerOptions
+                   . readFunction fileType (readOptions parserState fileType)
   where
     readFunction ReStructuredText        = readRST
     readFunction LaTeX                   = readLaTeX
@@ -42,17 +42,16 @@ getRenderFunction fileType = do
 -- | An action that renders the list of page sections to a context using pandoc
 --
 renderAction :: HakyllAction [PageSection] Context
-renderAction = createHakyllAction $ \sections -> do
-    let path = fromMaybe "unknown" $ lookup "path" 
-                                   $ map (\(x, y, _) -> (x, y))
-                                   $ map unPageSection sections
-    render' <- getRenderFunction $ getFileType path
-    runHakyllAction $ arr (const sections) >>> renderActionWith render'
+renderAction = (arr id &&& (getFileType' >>> getRenderFunction))
+             >>> renderActionWith
+  where
+    getFileType' = arr $ getFileType . fromMaybe "unknown" . lookup "path" 
+                       . map (\(x, y, _) -> (x, y)) . map unPageSection
 
 -- | An action to render pages, offering just a little more flexibility
 --
-renderActionWith :: (String -> String) -> HakyllAction [PageSection] Context
-renderActionWith render' = createHakyllAction $ \sections -> return $
-    Context $ M.fromList $ map (renderTriple . unPageSection) sections
+renderActionWith :: HakyllAction ([PageSection], String -> String) Context
+renderActionWith = createHakyllAction $ \(sections, render') -> return $
+    Context $ M.fromList $ map (renderTriple render' . unPageSection) sections
   where
-    renderTriple (k, v, r) = second (if r then render' else id) (k, v)
+    renderTriple render' (k, v, r) = second (if r then render' else id) (k, v)
-- 
cgit v1.2.3