module Text.Hakyll.Page
( Page
, fromContext
, getValue
, getBody
, readPage
) where
import qualified Data.Map as M
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Control.Parallel.Strategies (rdeepseq, ($|))
import System.FilePath (FilePath, takeExtension)
import System.IO
import Text.Hakyll.File
import Text.Hakyll.Util (trim)
import Text.Hakyll.Context (Context)
import Text.Hakyll.Renderable
import Text.Pandoc
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
writerOptions :: WriterOptions
writerOptions = defaultWriterOptions
renderFunction :: String -> (String -> String)
renderFunction ".html" = id
renderFunction ext = writeHtmlString writerOptions
. readFunction ext defaultParserState
where
readFunction ".markdown" = readMarkdown
readFunction ".md" = readMarkdown
readFunction ".tex" = readLaTeX
readFunction _ = readMarkdown
readMetaData :: Handle -> IO [(String, String)]
readMetaData handle = do
line <- hGetLine handle
if isDelimiter line
then return []
else do others <- readMetaData handle
return $ (trimPair . break (== ':')) line : others
where
trimPair (key, value) = (trim key, trim $ tail value)
isDelimiter :: String -> Bool
isDelimiter = L.isPrefixOf "---"
cachePage :: Page -> IO ()
cachePage page@(Page mapping) = do
let destination = toCache $ getURL page
makeDirectories destination
handle <- openFile destination WriteMode
hPutStrLn handle "---"
mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
hPutStrLn handle "---"
hPutStr handle $ getBody page
hClose handle
where
writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v
hPutStrLn h ""
readPage :: FilePath -> IO Page
readPage pagePath = do
getFromCache <- isCacheValid cacheFile [pagePath]
let path = if getFromCache then cacheFile else pagePath
handle <- openFile path ReadMode
line <- hGetLine handle
(metaData, body) <-
if isDelimiter line
then do md <- readMetaData handle
b <- hGetContents handle
return (md, b)
else do b <- hGetContents handle
return ([], line ++ "\n" ++ b)
let rendered = (renderFunction $ takeExtension path) body
page = fromContext $ M.fromList $
[ ("body", rendered)
, ("url", url)
, ("path", pagePath)
] ++ metaData
seq (($|) id rdeepseq rendered) $ hClose handle
if getFromCache then return () else cachePage page
return page
where
url = toURL pagePath
cacheFile = toCache url
instance Renderable Page where
getDependencies = (:[]) . getPagePath
getURL = getPageURL
toContext (Page page) = return page