module Text.Hakyll.Page
( Page
, fromContext
, getValue
, getBody
, readPage
, splitAtDelimiters
) where
import qualified Data.Map as M
import Data.List (isPrefixOf)
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
import Control.Parallel.Strategies (rdeepseq, ($|))
import Control.Monad.Reader (liftIO)
import System.FilePath (takeExtension)
import System.IO
import Text.Pandoc
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
import Text.Hakyll.Renderable
import Text.Hakyll.Regex (substituteRegex, matchesRegex)
data Page = Page Context
fromContext :: Context -> Page
fromContext = Page
getValue :: String -> Page -> String
getValue str (Page page) = fromMaybe [] $ M.lookup str page
getPageURL :: Page -> String
getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
getPagePath :: Page -> String
getPagePath (Page page) =
fromMaybe (error "No page path") $ M.lookup "path" page
getBody :: Page -> String
getBody (Page page) = fromMaybe [] $ M.lookup "body" page
readerOptions :: ParserState
readerOptions = defaultParserState { stateSmart = True }
writerOptions :: WriterOptions
writerOptions = defaultWriterOptions
getRenderFunction :: String -> (String -> String)
getRenderFunction ".html" = id
getRenderFunction ext = writeHtmlString writerOptions
. readFunction ext readerOptions
where
readFunction ".rst" = readRST
readFunction ".tex" = readLaTeX
readFunction _ = readMarkdown
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)]
readPage :: FilePath -> Hakyll Page
readPage path = do
let renderFunction = getRenderFunction $ takeExtension path
sectionFunctions = map (readSection renderFunction)
(True : repeat False)
handle <- liftIO $ openFile path ReadMode
sections <- fmap (splitAtDelimiters . lines )
(liftIO $ hGetContents handle)
let context = concat $ zipWith ($) sectionFunctions sections
page = fromContext $ M.fromList $
[ ("url", url)
, ("path", path)
] ++ context
seq (($|) id rdeepseq context) $ liftIO $ hClose handle
return page
where
url = toURL path
instance Renderable Page where
getDependencies = (:[]) . getPagePath
getURL = getPageURL
toContext (Page page) = return page