diff options
| -rw-r--r-- | hakyll.cabal | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/Read.hs | 80 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Page/Tests.hs | 14 |
3 files changed, 50 insertions, 45 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 2816e88..6c19232 100644 --- a/hakyll.cabal +++ b/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, diff --git a/src/Hakyll/Web/Page/Read.hs b/src/Hakyll/Web/Page/Read.hs index cf39ddd..bd77789 100644 --- a/src/Hakyll/Web/Page/Read.hs +++ b/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 - --- | Read an entire page +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' + +-- | 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 diff --git a/tests/Hakyll/Web/Page/Tests.hs b/tests/Hakyll/Web/Page/Tests.hs index b44daca..8e01302 100644 --- a/tests/Hakyll/Web/Page/Tests.hs +++ 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" ] |