module Text.Hakyll.Internal.Page
( readPage
) where
import qualified Data.Map as M
import Data.List (isPrefixOf)
import Data.Char (isSpace)
import Control.Monad.Reader (liftIO)
import System.FilePath
import Text.Pandoc
import Text.Hakyll.Context (Context)
import Text.Hakyll.File
import Text.Hakyll.HakyllMonad
import Text.Hakyll.Regex (substituteRegex, matchesRegex)
import Text.Hakyll.Util (trim)
import Text.Hakyll.Internal.Cache
import Text.Hakyll.Internal.FileType
readerOptions :: ParserState
readerOptions = defaultParserState
{
stateSmart = True
}
writerOptions :: WriterOptions
writerOptions = defaultWriterOptions
{
writerLiterateHaskell = True
}
getRenderFunction :: FileType -> (String -> String)
getRenderFunction Html = id
getRenderFunction Text = id
getRenderFunction fileType = writeHtmlString writerOptions
. readFunction fileType (readOptions fileType)
where
readFunction ReStructuredText = readRST
readFunction LaTeX = readLaTeX
readFunction Markdown = readMarkdown
readFunction LiterateHaskellMarkdown = readMarkdown
readFunction t = error $ "Cannot render " ++ show t
readOptions LiterateHaskellMarkdown =
readerOptions { stateLiterateHaskell = True }
readOptions _ = readerOptions
splitAtDelimiters :: [String] -> [[String]]
splitAtDelimiters [] = []
splitAtDelimiters ls@(x:xs)
| isDelimiter x = let (content, rest) = break isDelimiter xs
in (x : content) : splitAtDelimiters rest
| otherwise = [ls]
isDelimiter :: String -> Bool
isDelimiter = isPrefixOf "---"
readSection :: (String -> String)
-> Bool
-> [String]
-> [(String, String)]
readSection _ _ [] = []
readSection renderFunction isFirst ls
| not isDelimiter' = body ls
| isNamedDelimiter = readSectionMetaData ls
| isFirst = readSimpleMetaData (tail ls)
| otherwise = body (tail ls)
where
isDelimiter' = isDelimiter (head ls)
isNamedDelimiter = head ls `matchesRegex` "^----* *[a-zA-Z0-9][a-zA-Z0-9]*"
body ls' = [("body", renderFunction $ unlines ls')]
readSimpleMetaData = map readPair . filter (not . all isSpace)
readPair = trimPair . break (== ':')
trimPair (key, value) = (trim key, trim $ tail value)
readSectionMetaData [] = []
readSectionMetaData (header:value) =
let key = substituteRegex "[^a-zA-Z0-9]" "" header
in [(key, renderFunction $ unlines value)]
readPageFromFile :: FilePath -> Hakyll Context
readPageFromFile path = do
let renderFunction = getRenderFunction $ getFileType path
sectionFunctions = map (readSection renderFunction)
(True : repeat False)
contents <- liftIO $ readFile path
url <- toUrl path
let sections = splitAtDelimiters $ lines contents
sectionsData = concat $ zipWith ($) sectionFunctions sections
context = M.fromList $
("url", url) : ("path", path) : category ++ sectionsData
return context
where
category = let dirs = splitDirectories $ takeDirectory path
in [("category", last dirs) | not (null dirs)]
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