@@ -12,7 +12,7 @@ import Data.Maybe (fromMaybe)
12import Control.Parallel.Strategies (rdeepseq, ($|))
12import Control.Parallel.Strategies (rdeepseq, ($|))
13import Control.Monad.Reader (liftIO)
13import Control.Monad.Reader (liftIO)
14import System.FilePath (takeExtension)
14import System.FilePath (takeExtension)
15−import System.IO (Handle, IOMode(..), openFile, hClose)
15+import System.IO (IOMode(..), openFile, hClose)
16import qualified System.IO.UTF8 as U
16import qualified System.IO.UTF8 as U
18import Text.Pandoc
18import Text.Pandoc
@@ -22,6 +22,7 @@ import Text.Hakyll.File
22import Text.Hakyll.Util (trim)
22import Text.Hakyll.Util (trim)
23import Text.Hakyll.Context (Context)
23import Text.Hakyll.Context (Context)
24import Text.Hakyll.Renderable
24import Text.Hakyll.Renderable
25+import Text.Hakyll.Regex (substituteRegex, matchesRegex)
26-- | A Page is basically key-value mapping. Certain keys have special
27-- | A Page is basically key-value mapping. Certain keys have special
27-- meanings, like for example url, body and title.
28-- meanings, like for example url, body and title.
@@ -56,25 +57,22 @@ writerOptions :: WriterOptions
56writerOptions = defaultWriterOptions
57writerOptions = defaultWriterOptions
58-- | Get a render function for a given extension.
59-- | Get a render function for a given extension.
59−renderFunction :: String -> (String -> String)
60+getRenderFunction :: String -> (String -> String)
60−renderFunction ".html" = id
61+getRenderFunction ".html" = id
61−renderFunction ext = writeHtmlString writerOptions
62+getRenderFunction ext = writeHtmlString writerOptions
62− . readFunction ext defaultParserState
63+ . readFunction ext defaultParserState
64 readFunction ".rst" = readRST
65 readFunction ".rst" = readRST
65 readFunction ".tex" = readLaTeX
66 readFunction ".tex" = readLaTeX
66 readFunction _ = readMarkdown
67 readFunction _ = readMarkdown
68−-- | Read metadata header from a file handle.
69+-- | Split a page into sections.
69−readMetaData :: Handle -> Hakyll [(String, String)]
70+splitAtDelimiters :: [String] -> [[String]]
70−readMetaData handle = do
71+splitAtDelimiters [] = []
71− line <- liftIO $ U.hGetLine handle
72+splitAtDelimiters ls@(x:xs)
72− if isDelimiter line
73+ | isDelimiter x = let (content, rest) = break isDelimiter xs
73− then return []
74+ in (x : content) : splitAtDelimiters rest
74− else do others <- readMetaData handle
75+ | otherwise = [ls]
75− return $ (trimPair . break (== ':')) line : others
77− trimPair (key, value) = (trim key, trim $ tail value)
79-- | Check if the given string is a metadata delimiter.
77-- | Check if the given string is a metadata delimiter.
80isDelimiter :: String -> Bool
78isDelimiter :: String -> Bool
@@ -106,6 +104,31 @@ cachePage page@(Page mapping) = do
107 destination = toCache $ getURL page
105 destination = toCache $ getURL page
107+-- | Read one section of a page.
108+readSection :: (String -> String) -- ^ Render function.
109+ -> Bool -- ^ If this section is the first section in the page.
110+ -> [String] -- ^ Lines in the section.
111+ -> [(String, String)] -- ^ Key-values extracted.
112+readSection _ _ [] = []
113+readSection renderFunction True ls
114+ | isDelimiter (head ls) = readSimpleMetaData (tail ls)
115+ | otherwise = [("body", renderFunction $ unlines ls)]
117+ readSimpleMetaData = map readPair
118+ readPair = (trimPair . break (== ':'))
119+ trimPair (key, value) = (trim key, trim $ tail value)
121+readSection renderFunction False ls
122+ | isDelimiter (head ls) = readSectionMetaData ls
123+ | otherwise = error $ "Page parsing error at: " ++ head ls
125+ readSectionMetaData [] = []
126+ readSectionMetaData (header:value) =
127+ let key = if header `matchesRegex` "----* *[a-zA-Z][a-zA-Z]*"
128+ then substituteRegex "[^a-zA-Z]" "" header
130+ in [(key, renderFunction $ unlines value)]
109-- | Read a page from a file. Metadata is supported, and if the filename
132-- | Read a page from a file. Metadata is supported, and if the filename
110-- has a @.markdown@ extension, it will be rendered using pandoc.
133-- has a @.markdown@ extension, it will be rendered using pandoc.
111readPage :: FilePath -> Hakyll Page
134readPage :: FilePath -> Hakyll Page
@@ -113,27 +136,22 @@ readPage pagePath = do
113 -- Check cache.
136 -- Check cache.
114 getFromCache <- isCacheValid cacheFile [pagePath]
137 getFromCache <- isCacheValid cacheFile [pagePath]
115 let path = if getFromCache then cacheFile else pagePath
138 let path = if getFromCache then cacheFile else pagePath
139+ renderFunction = getRenderFunction $ takeExtension path
140+ sectionFunctions = map (readSection renderFunction)
141+ (True : repeat False)
117 -- Read file.
143 -- Read file.
118 handle <- liftIO $ openFile path ReadMode
144 handle <- liftIO $ openFile path ReadMode
119− line <- liftIO $ U.hGetLine handle
145+ sections <- fmap (splitAtDelimiters . lines )
122− then do md <- readMetaData handle
123− b <- liftIO $ U.hGetContents handle
125− else do b <- liftIO $ U.hGetContents handle
146+ (liftIO $ U.hGetContents handle)
126− return ([], line ++ "\n" ++ b)
147+
127−
148+ let context = concat $ zipWith ($) sectionFunctions sections
129− let rendered = (renderFunction $ takeExtension path) body
130 page = fromContext $ M.fromList $
149 page = fromContext $ M.fromList $
131− [ ("body", rendered)
132− , ("url", url)
150+ [ ("url", url)
133 , ("path", pagePath)
151 , ("path", pagePath)
134− ] ++ metaData
152+ ] ++ context
136− seq (($|) id rdeepseq rendered) $ liftIO $ hClose handle
154+ seq (($|) id rdeepseq context) $ liftIO $ hClose handle
138 -- Cache if needed
156 -- Cache if needed
139 if getFromCache then return () else cachePage page
157 if getFromCache then return () else cachePage page