Added basic support for metadata sections.

2 files changed, 59 insertions, 33 deletions

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 28d3540..41ddba6 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -12,7 +12,7 @@ import Data.Maybe (fromMaybe)
 import Control.Parallel.Strategies (rdeepseq, ($|))
 import Control.Monad.Reader (liftIO)
 import System.FilePath (takeExtension)
-import System.IO (Handle, IOMode(..), openFile, hClose)
+import System.IO (IOMode(..), openFile, hClose)
 import qualified System.IO.UTF8 as U
 
 import Text.Pandoc
@@ -22,6 +22,7 @@ import Text.Hakyll.File
 import Text.Hakyll.Util (trim)
 import Text.Hakyll.Context (Context)
 import Text.Hakyll.Renderable
+import Text.Hakyll.Regex (substituteRegex, matchesRegex)
 
 -- | A Page is basically key-value mapping. Certain keys have special
 --   meanings, like for example url, body and title.
@@ -56,25 +57,22 @@ writerOptions :: WriterOptions
 writerOptions = defaultWriterOptions
 
 -- | Get a render function for a given extension.
-renderFunction :: String -> (String -> String)
-renderFunction ".html" = id
-renderFunction ext = writeHtmlString writerOptions
-                   . readFunction ext defaultParserState
+getRenderFunction :: String -> (String -> String)
+getRenderFunction ".html" = id
+getRenderFunction ext = writeHtmlString writerOptions
+                      . readFunction ext defaultParserState
   where
     readFunction ".rst" = readRST
     readFunction ".tex" = readLaTeX
     readFunction _      = readMarkdown
 
--- | Read metadata header from a file handle.
-readMetaData :: Handle -> Hakyll [(String, String)]
-readMetaData handle = do
-    line <- liftIO $ U.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)
+-- | Split a page into sections.
+splitAtDelimiters :: [String] -> [[String]]
+splitAtDelimiters [] = []
+splitAtDelimiters ls@(x:xs)
+    | isDelimiter x = let (content, rest) = break isDelimiter xs
+                      in (x : content) : splitAtDelimiters rest
+    | otherwise = [ls]
 
 -- | Check if the given string is a metadata delimiter.
 isDelimiter :: String -> Bool
@@ -106,6 +104,31 @@ cachePage page@(Page mapping) = do
 
     destination = toCache $ getURL page
 
+-- | Read one section of a page.
+readSection :: (String -> String) -- ^ Render function.
+            -> Bool -- ^ If this section is the first section in the page.
+            -> [String] -- ^ Lines in the section.
+            -> [(String, String)] -- ^ Key-values extracted.
+readSection _ _ [] = []
+readSection renderFunction True ls
+    | isDelimiter (head ls) = readSimpleMetaData (tail ls)
+    | otherwise = [("body", renderFunction $ unlines ls)]
+  where
+    readSimpleMetaData = map readPair
+    readPair = (trimPair . break (== ':'))
+    trimPair (key, value) = (trim key, trim $ tail value)
+
+readSection renderFunction False ls
+    | isDelimiter (head ls) = readSectionMetaData ls
+    | otherwise = error $ "Page parsing error at: " ++ head ls
+  where
+    readSectionMetaData [] = []
+    readSectionMetaData (header:value) =
+        let key = if header `matchesRegex` "----*  *[a-zA-Z][a-zA-Z]*"
+                      then substituteRegex "[^a-zA-Z]" "" header
+                      else "body"
+        in [(key, renderFunction $ unlines value)]
+
 -- | Read a page from a file. Metadata is supported, and if the filename
 --   has a @.markdown@ extension, it will be rendered using pandoc.
 readPage :: FilePath -> Hakyll Page
@@ -113,27 +136,22 @@ readPage pagePath = do
     -- Check cache.
     getFromCache <- isCacheValid cacheFile [pagePath]
     let path = if getFromCache then cacheFile else pagePath
+        renderFunction = getRenderFunction $ takeExtension path
+        sectionFunctions = map (readSection renderFunction)
+                               (True : repeat False)
 
     -- Read file.
     handle <- liftIO $ openFile path ReadMode
-    line <- liftIO $ U.hGetLine handle
-    (metaData, body) <-
-        if isDelimiter line
-            then do md <- readMetaData handle
-                    b <- liftIO $ U.hGetContents handle
-                    return (md, b)
-            else do b <- liftIO $ U.hGetContents handle
-                    return ([], line ++ "\n" ++ b)
-
-    -- Render file
-    let rendered = (renderFunction $ takeExtension path) body
+    sections <- fmap (splitAtDelimiters . lines )
+                     (liftIO $ U.hGetContents handle)
+
+    let context = concat $ zipWith ($) sectionFunctions sections
         page = fromContext $ M.fromList $
-            [ ("body", rendered)
-            , ("url", url)
+            [ ("url", url)
             , ("path", pagePath)
-            ] ++ metaData
+            ] ++ context
 
-    seq (($|) id rdeepseq rendered) $ liftIO $ hClose handle
+    seq (($|) id rdeepseq context) $ liftIO $ hClose handle
 
     -- Cache if needed
     if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
index 37bbc7e..9b7177e 100644
--- a/src/Text/Hakyll/Regex.hs
+++ b/src/Text/Hakyll/Regex.hs
@@ -1,8 +1,10 @@
 -- | A module that exports a simple regex interface. This code is mostly copied
---   from the regex-compat package at hackage.
+--   from the regex-compat package at hackage. I decided to write this module
+--   because I want to abstract the regex package used.
 module Text.Hakyll.Regex
     ( splitRegex
     , substituteRegex
+    , matchesRegex
     ) where
 
 import Text.Regex.TDFA
@@ -58,9 +60,15 @@ splitRegex :: String -> String -> [String]
 splitRegex pattern = filter (not . null)
                    . splitRegex' (makeRegex pattern)
 
--- | Substitute a regex. Simplified interface.
+-- | Substitute a regex. Simplified interface. This function performs a global
+--   substitution.
 substituteRegex :: String -- ^ Pattern to replace (regex).
                 -> String -- ^ Replacement string.
                 -> String -- ^ Input string.
                 -> String -- ^ Result.
-substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement
+substituteRegex pattern replacement string =
+    subRegex (makeRegex pattern) string replacement
+
+-- | Simple regex matching.
+matchesRegex :: String -> String -> Bool
+matchesRegex string pattern = string =~ pattern