Separate pandoc from page reading, general caching

1 files changed, 37 insertions, 60 deletions

diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index 92fb4fc..9e715d5 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -1,47 +1,29 @@
 -- | A module for dealing with @Page@s. This module is mostly internally used.
 module Text.Hakyll.Internal.Page
-    ( readPage
+    ( PageSection (..)
+    , readPage
+    , readPageAction
     ) where
 
-import qualified Data.Map as M
 import Data.List (isPrefixOf)
 import Data.Char (isSpace)
 import Control.Monad.Reader (liftIO)
 import System.FilePath
 import Control.Monad.State (State, evalState, get, put)
 
-import Text.Pandoc
-
-import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.File
 import Text.Hakyll.HakyllMonad
+import Text.Hakyll.HakyllAction
 import Text.Hakyll.Regex (substituteRegex, matchesRegex)
 import Text.Hakyll.Util (trim)
-import Text.Hakyll.Internal.Cache
-import Text.Hakyll.Internal.FileType
-
--- | 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)
-  where
-    readFunction ReStructuredText        = readRST
-    readFunction LaTeX                   = readLaTeX
-    readFunction Markdown                = readMarkdown
-    readFunction LiterateHaskellMarkdown = readMarkdown
-    readFunction t                       = error $ "Cannot render " ++ show t
 
-    readOptions options LiterateHaskellMarkdown = options
-        { stateLiterateHaskell = True }
-    readOptions options _                       = options
+-- | Page info handle: (key, value, needs rendering)
+--
+data PageSection = PageSection {unPageSection :: [(String, String, Bool)]}
+                 deriving (Show)
 
 -- | Split a page into sections.
+--
 splitAtDelimiters :: [String] -> State (Maybe String) [[String]]
 splitAtDelimiters [] = return []
 splitAtDelimiters ls@(x:xs) = do
@@ -63,59 +45,54 @@ isPossibleDelimiter :: String -> Bool
 isPossibleDelimiter = isPrefixOf "---"
 
 -- | Read one section of a page.
-readSection :: (String -> String) -- ^ Render function.
-            -> Bool -- ^ If this section is the first section in the page.
+--
+readSection :: Bool -- ^ If this section is the first section in the page.
             -> [String] -- ^ Lines in the section.
-            -> [(String, String)] -- ^ Key-values extracted.
-readSection _ _ [] = []
-readSection renderFunction isFirst ls
+            -> PageSection -- ^ Key-values extracted.
+readSection _ [] = PageSection []
+readSection isFirst ls
     | not isDelimiter' = body ls
-    | isNamedDelimiter = readSectionMetaData ls
-    | isFirst = readSimpleMetaData (drop 1 ls)
+    | isNamedDelimiter = PageSection $ readSectionMetaData ls
+    | isFirst = PageSection $ readSimpleMetaData (drop 1 ls)
     | otherwise = body (drop 1 ls)
   where
     isDelimiter' = isPossibleDelimiter (head ls)
     isNamedDelimiter = head ls `matchesRegex` "^----*  *[a-zA-Z0-9][a-zA-Z0-9]*"
-    body ls' = [("body", renderFunction $ unlines ls')]
+    body ls' = PageSection [("body", unlines ls', True)]
 
     readSimpleMetaData = map readPair . filter (not . all isSpace)
     readPair = trimPair . break (== ':')
-    trimPair (key, value) = (trim key, trim $ drop 1 value)
+    trimPair (key, value) = (trim key, trim (drop 1 value), False)
 
     readSectionMetaData [] = []
     readSectionMetaData (header:value) =
         let key = substituteRegex "[^a-zA-Z0-9]" "" header
-        in [(key, renderFunction $ unlines value)]
+        in [(key, unlines value, True)]
 
--- | Read a page from a file. Metadata is supported, and if the filename
---   has a @.markdown@ extension, it will be rendered using pandoc.
-readPageFromFile :: FilePath -> Hakyll Context
-readPageFromFile path = do
-    renderFunction <- getRenderFunction $ getFileType path
-    let sectionFunctions = map (readSection renderFunction)
-                               (True : repeat False)
+-- | Read a page from a file. Metadata is supported.
+--
+readPage :: FilePath -> Hakyll [PageSection]
+readPage path = do
+    let sectionFunctions = map readSection $ True : repeat False
 
     -- Read file.
     contents <- liftIO $ readFile path
     url <- toUrl path
     let sections = evalState (splitAtDelimiters $ lines contents) Nothing
-        sectionsData = concat $ zipWith ($) sectionFunctions sections
-        context = M.fromList $
-            ("url", url) : ("path", path) : category ++ sectionsData
+        sectionsData = zipWith ($) sectionFunctions sections
 
-    return $ Context context
+    return $ PageSection [ ("url", url, False)
+                         , ("path", path, False)
+                         ] : category : sectionsData
   where
     category = let dirs = splitDirectories $ takeDirectory path
-               in [("category", last dirs) | not (null dirs)]
+               in PageSection [("category", last dirs, False) | not (null dirs)]
 
--- | Read a page. Might fetch it from the cache if available. Otherwise, it will
---   read it from the file given and store it in the cache.
-readPage :: FilePath -> Hakyll Context
-readPage path = do
-    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
-    if isCacheMoreRecent' then getFromCache fileName
-                          else do page <- readPageFromFile path
-                                  storeInCache page fileName
-                                  return page
-  where
-    fileName = "pages" </> path
+-- | Read a page from a file. Metadata is supported.
+--
+readPageAction :: FilePath -> HakyllAction () [PageSection]
+readPageAction path = HakyllAction
+    { actionDependencies = [path]
+    , actionUrl          = Left $ toUrl path
+    , actionFunction     = const $ readPage path
+    }