@@ -4,57 +4,53 @@ module Hakyll.Web.Page.Read
7−import Control.Applicative ((<$>), (<*>))
7+import Control.Applicative ((<$>), (<*>), (<*))
8−import Control.Arrow (second, (***))
9−import Control.Monad.State (State, get, put, evalState)
10−import Data.List (isPrefixOf)
12import qualified Data.Map as M
8import qualified Data.Map as M
14−import Hakyll.Web.Page.Internal
10+import Text.Parsec.Char (alphaNum, anyChar, char, newline, oneOf, string)
11+import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1)
12+import Text.Parsec.Prim (many, parse, skipMany, (<?>))
13+import Text.Parsec.String (Parser)
15import Hakyll.Core.Util.String
15import Hakyll.Core.Util.String
16+import Hakyll.Web.Page.Internal
17−-- | We're using a simple state monad as parser
18+-- | Space or tab, no newline
18−--
19+inlineSpace :: Parser Char
19−type LineParser = State [String]
20+inlineSpace = oneOf ['\t', ' '] <?> "space"
21−-- | Read the metadata section from a page
22+-- | Parse a single metadata field
23−parseMetadata :: LineParser (Map String String)
24+metadataField :: Parser (String, String)
24−parseMetadata = get >>= \content -> case content of
25+metadataField = do
25− -- No lines means no metadata
26+ key <- manyTill alphaNum $ char ':'
26− [] -> return M.empty
27+ skipMany1 inlineSpace
27− -- Check if the file begins with a delimiter
28+ value <- manyTill anyChar newline
28− (l : ls) -> if not (isPossibleDelimiter l)
29+ trailing' <- many trailing
29− then -- No delimiter means no metadata
30+ return (key, trim $ value ++ concat trailing')
31− else do -- Break the metadata section
32− let (metadata, rest) = second (drop 1) $ break (== l) ls
35− -- Parse the metadata
36− return $ M.fromList $ map parseMetadata' metadata
38− -- Check if a line can be a delimiter
32+ trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline
39− isPossibleDelimiter = isPrefixOf "---"
41− -- Parse a "key: value" string to a (key, value) tupple
34+-- | Parse a metadata block, including delimiters and trailing newlines
42− parseMetadata' = (trim *** trim . drop 1) . break (== ':')
44−-- | Read the body section of a page
46−parseBody :: LineParser String
36+metadata :: Parser [(String, String)]
47−parseBody = do
37+metadata = do
48− body <- get
38+ open <- many1 (char '-') <* many inlineSpace <* newline
49− put []
39+ metadata' <- many metadataField
50− return $ unlines body
40+ _ <- choice $ map (string . replicate (length open)) ['-', '.']
51−
41+ skipMany inlineSpace
52−-- | Read an entire page
42+ skipMany1 newline
45+-- | Parse a Hakyll page
54−parsePage :: LineParser (Page String)
47+page :: Parser ([(String, String)], String)
55−parsePage = Page <$> parseMetadata <*> parseBody
48+page = do
49+ metadata' <- option [] metadata
51+ return (metadata', body)
57−-- | Read a page from a string
59readPage :: String -> Page String
53readPage :: String -> Page String
60−readPage = evalState parsePage . lines
54+readPage input = case parse page "page" input of
55+ Left err -> error (show err)
56+ Right (md, b) -> Page (M.fromList md) b