module Text.Hakyll.Page
( Page,
PageValue,
addContext,
getURL,
getBody,
readPage,
pageFromList,
concatPages,
concatPagesWith
) where
import qualified Data.Map as M
import qualified Data.List as L
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Control.Monad
import System.FilePath
import System.IO
import Text.Hakyll.Util
import Text.Pandoc
type Page = M.Map String PageValue
type PageValue = B.ByteString
addContext :: String -> String -> Page -> Page
addContext key value = M.insert key (B.pack value)
getURL :: Page -> String
getURL context = let result = M.lookup "url" context
in case result of (Just url) -> B.unpack url
Nothing -> error "URL is not defined."
getBody :: Page -> PageValue
getBody context = fromMaybe B.empty $ M.lookup "body" context
writerOptions :: WriterOptions
writerOptions = defaultWriterOptions
renderFunction :: String -> (String -> String)
renderFunction ".html" = id
renderFunction ext = writeHtmlString writerOptions .
renderFunction' ext defaultParserState
where renderFunction' ".markdown" = readMarkdown
renderFunction' ".md" = readMarkdown
renderFunction' ".tex" = readLaTeX
renderFunction' _ = 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 = do
let destination = toCache $ getURL page
makeDirectories destination
handle <- openFile destination WriteMode
hPutStrLn handle "---"
mapM_ (writePair handle) $ M.toList page
hPutStrLn handle "---"
B.hPut handle $ getBody page
hClose handle
where writePair _ ("body", _) = return ()
writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h ""
readPage :: FilePath -> IO Page
readPage pagePath = do
getFromCache <- isCacheFileValid cacheFile pagePath
let path = if getFromCache then cacheFile else pagePath
handle <- openFile path ReadMode
line <- hGetLine handle
(context, body) <- if isDelimiter line
then do md <- readMetaData handle
c <- hGetContents handle
return (md, c)
else hGetContents handle >>= \b -> return ([], line ++ b)
let rendered = B.pack $ (renderFunction $ takeExtension path) body
seq rendered $ hClose handle
let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context
if getFromCache then return () else cachePage page
return page
where url = addExtension (dropExtension pagePath) ".html"
cacheFile = toCache url
pageFromList :: [(String, String)] -> Page
pageFromList = M.fromList . map packPair
where packPair (k, v) = let pv = B.pack v
in seq pv (k, pv)
concatPages :: [Page] -> PageValue
concatPages = concatPagesWith "body"
concatPagesWith :: String
-> [Page]
-> PageValue
concatPagesWith key = B.concat . map (fromMaybe B.empty . M.lookup key)