Allow ... as metadata delimiter

hakyll.cabal

@@ -68,6 +68,7 @@ Library
     old-locale  >= 1.0   && < 2.0,
     old-time    >= 1.0   && < 1.3,
     pandoc      >= 1.6   && < 2.0,
+    parsec      >= 2.1   && < 3.2,
     process     >= 1.0   && < 1.4,
     regex-base  >= 0.93  && < 1.0,
     regex-pcre  >= 0.93  && < 1.0,

src/Hakyll/Web/Page/Read.hs

@@ -4,57 +4,53 @@ module Hakyll.Web.Page.Read
     ( readPage
     ) where
 
-import Control.Applicative ((<$>), (<*>))
-import Control.Arrow (second, (***))
-import Control.Monad.State (State, get, put, evalState)
-import Data.List (isPrefixOf)
-import Data.Map (Map)
+import Control.Applicative ((<$>), (<*>), (<*))
 import qualified Data.Map as M
 
-import Hakyll.Web.Page.Internal
+import Text.Parsec.Char (alphaNum, anyChar, char, newline, oneOf, string)
+import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1)
+import Text.Parsec.Prim (many, parse, skipMany, (<?>))
+import Text.Parsec.String (Parser)
+
 import Hakyll.Core.Util.String
+import Hakyll.Web.Page.Internal
 
--- | We're using a simple state monad as parser
---
-type LineParser = State [String]
+-- | Space or tab, no newline
+inlineSpace :: Parser Char
+inlineSpace = oneOf ['\t', ' '] <?> "space"
 
--- | Read the metadata section from a page
+-- | Parse a single metadata field
 --
-parseMetadata :: LineParser (Map String String)
-parseMetadata = get >>= \content -> case content of
-    -- No lines means no metadata
-    [] -> return M.empty
-    -- Check if the file begins with a delimiter
-    (l : ls) -> if not (isPossibleDelimiter l)
-        then -- No delimiter means no metadata
-             return M.empty
-        else do -- Break the metadata section
-                let (metadata, rest) = second (drop 1) $ break (== l) ls
-                -- Put the rest back
-                put rest
-                -- Parse the metadata
-                return $ M.fromList $ map parseMetadata' metadata
+metadataField :: Parser (String, String)
+metadataField = do
+    key <- manyTill alphaNum $ char ':'
+    skipMany1 inlineSpace
+    value <- manyTill anyChar newline
+    trailing' <- many trailing
+    return (key, trim $ value ++ concat trailing')
   where
-    -- Check if a line can be a delimiter
-    isPossibleDelimiter = isPrefixOf "---"
+    trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline
 
-    -- Parse a "key: value" string to a (key, value) tupple
-    parseMetadata' = (trim *** trim . drop 1) . break (== ':')
-
--- | Read the body section of a page
+-- | Parse a metadata block, including delimiters and trailing newlines
 --
-parseBody :: LineParser String
-parseBody = do
-    body <- get
-    put []
-    return $ unlines body
+metadata :: Parser [(String, String)]
+metadata = do
+    open <- many1 (char '-') <* many inlineSpace <* newline
+    metadata' <- many metadataField
+    _ <- choice $ map (string . replicate (length open)) ['-', '.']
+    skipMany inlineSpace
+    skipMany1 newline
+    return metadata'
 
--- | Read an entire page
+-- | Parse a Hakyll page
 --
-parsePage :: LineParser (Page String)
-parsePage = Page <$> parseMetadata <*> parseBody
+page :: Parser ([(String, String)], String)
+page = do
+    metadata' <- option [] metadata
+    body <- many anyChar
+    return (metadata', body)
 
--- | Read a page from a string
---
 readPage :: String -> Page String
-readPage = evalState parsePage . lines
+readPage input = case parse page "page" input of
+    Left err      -> error (show err)
+    Right (md, b) -> Page (M.fromList md) b

tests/Hakyll/Web/Page/Tests.hs

@@ -14,13 +14,13 @@ import TestSuite.Util
 
 tests :: [Test]
 tests = fromAssertions "readPage"
-    [ Page (M.singleton "foo" "bar") "body\n" @=? readPage
+    [ Page (M.singleton "foo" "bar") "body" @=? readPage
         "---        \n\
         \foo: bar   \n\
         \---        \n\
         \body"
 
-    , Page M.empty "line one\nlijn twee\n" @=? readPage
+    , Page M.empty "line one\nlijn twee" @=? readPage
         "line one\n\
         \lijn twee"
 
@@ -28,5 +28,13 @@ tests = fromAssertions "readPage"
         "---\n\
         \veld02: deux\n\
         \field1: unos\n\
-        \---"
+        \---\n"
+
+    , Page (M.fromList [("author", "jasper"), ("title", "lol")]) "O hai\n"
+        @=? readPage
+        "---\n\
+        \author: jasper\n\
+        \title: lol\n\
+        \...\n\
+        \O hai\n"
     ]