summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/Internal/Page.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll/Internal/Page.hs')
-rw-r--r--src/Text/Hakyll/Internal/Page.hs97
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
+ }