diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 235 |
1 files changed, 138 insertions, 97 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 4bda4dc23..3dd129529 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -155,13 +155,13 @@ type Parser t s = Parsec t s a >>~ b = a >>= \x -> b >> return x -- | Parse any line of text -anyLine :: Parsec [Char] st [Char] +anyLine :: Parser [Char] st [Char] anyLine = manyTill anyChar newline -- | Like @manyTill@, but reads at least one item. -many1Till :: Parsec [tok] st a - -> Parsec [tok] st end - -> Parsec [tok] st [a] +many1Till :: Parser [tok] st a + -> Parser [tok] st end + -> Parser [tok] st [a] many1Till p end = do first <- p rest <- manyTill p end @@ -170,7 +170,7 @@ many1Till p end = do -- | A more general form of @notFollowedBy@. This one allows any -- type of parser to be specified, and succeeds only if that parser fails. -- It does not consume any input. -notFollowedBy' :: Show b => Parsec [a] st b -> Parsec [a] st () +notFollowedBy' :: Show b => Parser [a] st b -> Parser [a] st () notFollowedBy' p = try $ join $ do a <- try p return (unexpected (show a)) <|> @@ -178,7 +178,7 @@ notFollowedBy' p = try $ join $ do a <- try p -- (This version due to Andrew Pimlott on the Haskell mailing list.) -- | Parses one of a list of strings (tried in order). -oneOfStrings :: [String] -> Parsec [Char] st String +oneOfStrings :: [String] -> Parser [Char] st String oneOfStrings [] = fail "no strings" oneOfStrings strs = do c <- anyChar @@ -189,35 +189,35 @@ oneOfStrings strs = do | otherwise -> (c:) `fmap` oneOfStrings strs' -- | Parses a space or tab. -spaceChar :: Parsec [Char] st Char +spaceChar :: Parser [Char] st Char spaceChar = satisfy $ \c -> c == ' ' || c == '\t' -- | Parses a nonspace, nonnewline character. -nonspaceChar :: Parsec [Char] st Char +nonspaceChar :: Parser [Char] st Char nonspaceChar = satisfy $ \x -> x /= '\t' && x /= '\n' && x /= ' ' && x /= '\r' -- | Skips zero or more spaces or tabs. -skipSpaces :: Parsec [Char] st () +skipSpaces :: Parser [Char] st () skipSpaces = skipMany spaceChar -- | Skips zero or more spaces or tabs, then reads a newline. -blankline :: Parsec [Char] st Char +blankline :: Parser [Char] st Char blankline = try $ skipSpaces >> newline -- | Parses one or more blank lines and returns a string of newlines. -blanklines :: Parsec [Char] st [Char] +blanklines :: Parser [Char] st [Char] blanklines = many1 blankline -- | Parses material enclosed between start and end parsers. -enclosed :: Parsec [Char] st t -- ^ start parser - -> Parsec [Char] st end -- ^ end parser - -> Parsec [Char] st a -- ^ content parser (to be used repeatedly) - -> Parsec [Char] st [a] +enclosed :: Parser [Char] st t -- ^ start parser + -> Parser [Char] st end -- ^ end parser + -> Parser [Char] st a -- ^ content parser (to be used repeatedly) + -> Parser [Char] st [a] enclosed start end parser = try $ start >> notFollowedBy space >> many1Till parser end -- | Parse string, case insensitive. -stringAnyCase :: [Char] -> Parsec [Char] st String +stringAnyCase :: [Char] -> Parser [Char] st String stringAnyCase [] = string "" stringAnyCase (x:xs) = do firstChar <- char (toUpper x) <|> char (toLower x) @@ -225,7 +225,7 @@ stringAnyCase (x:xs) = do return (firstChar:rest) -- | Parse contents of 'str' using 'parser' and return result. -parseFromString :: Parsec [tok] st a -> [tok] -> Parsec [tok] st a +parseFromString :: Parser [tok] st a -> [tok] -> Parser [tok] st a parseFromString parser str = do oldPos <- getPosition oldInput <- getInput @@ -236,7 +236,7 @@ parseFromString parser str = do return result -- | Parse raw line block up to and including blank lines. -lineClump :: Parsec [Char] st String +lineClump :: Parser [Char] st String lineClump = blanklines <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines) @@ -245,8 +245,8 @@ lineClump = blanklines -- pairs of open and close, which must be different. For example, -- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))" -- and return "hello (there)". -charsInBalanced :: Char -> Char -> Parsec [Char] st Char - -> Parsec [Char] st String +charsInBalanced :: Char -> Char -> Parser [Char] st Char + -> Parser [Char] st String charsInBalanced open close parser = try $ do char open let isDelim c = c == open || c == close @@ -271,7 +271,7 @@ uppercaseRomanDigits = map toUpper lowercaseRomanDigits -- | Parses a roman numeral (uppercase or lowercase), returns number. romanNumeral :: Bool -- ^ Uppercase if true - -> Parsec [Char] st Int + -> Parser [Char] st Int romanNumeral upperCase = do let romanDigits = if upperCase then uppercaseRomanDigits @@ -301,14 +301,14 @@ romanNumeral upperCase = do -- Parsers for email addresses and URIs -emailChar :: Parsec [Char] st Char +emailChar :: Parser [Char] st Char emailChar = alphaNum <|> satisfy (\c -> c == '-' || c == '+' || c == '_' || c == '.') -domainChar :: Parsec [Char] st Char +domainChar :: Parser [Char] st Char domainChar = alphaNum <|> char '-' -domain :: Parsec [Char] st [Char] +domain :: Parser [Char] st [Char] domain = do first <- many1 domainChar dom <- many1 $ try (char '.' >> many1 domainChar ) @@ -316,7 +316,7 @@ domain = do -- | Parses an email address; returns original and corresponding -- escaped mailto: URI. -emailAddress :: Parsec [Char] st (String, String) +emailAddress :: Parser [Char] st (String, String) emailAddress = try $ do firstLetter <- alphaNum restAddr <- many emailChar @@ -327,7 +327,7 @@ emailAddress = try $ do return (full, escapeURI $ "mailto:" ++ full) -- | Parses a URI. Returns pair of original and URI-escaped version. -uri :: Parsec [Char] st (String, String) +uri :: Parser [Char] st (String, String) uri = try $ do let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:", "news:", "telnet:" ] @@ -361,8 +361,8 @@ uri = try $ do -- displacement (the difference between the source column at the end -- and the source column at the beginning). Vertical displacement -- (source row) is ignored. -withHorizDisplacement :: Parsec [Char] st a -- ^ Parser to apply - -> Parsec [Char] st (a, Int) -- ^ (result, displacement) +withHorizDisplacement :: Parser [Char] st a -- ^ Parser to apply + -> Parser [Char] st (a, Int) -- ^ (result, displacement) withHorizDisplacement parser = do pos1 <- getPosition result <- parser @@ -371,7 +371,7 @@ withHorizDisplacement parser = do -- | Applies a parser and returns the raw string that was parsed, -- along with the value produced by the parser. -withRaw :: Parsec [Char] st a -> Parsec [Char] st (a, [Char]) +withRaw :: Parser [Char] st a -> Parser [Char] st (a, [Char]) withRaw parser = do pos1 <- getPosition inp <- getInput @@ -388,20 +388,20 @@ withRaw parser = do -- | Parses a character and returns 'Null' (so that the parser can move on -- if it gets stuck). -nullBlock :: Parsec [Char] st Block +nullBlock :: Parser [Char] st Block nullBlock = anyChar >> return Null -- | Fail unless we're in literate haskell mode. -failUnlessLHS :: Parsec [tok] ParserState () +failUnlessLHS :: Parser [tok] ParserState () failUnlessLHS = getOption readerLiterateHaskell >>= guard -- | Parses backslash, then applies character parser. -escaped :: Parsec [Char] st Char -- ^ Parser for character to escape - -> Parsec [Char] st Char +escaped :: Parser [Char] st Char -- ^ Parser for character to escape + -> Parser [Char] st Char escaped parser = try $ char '\\' >> parser -- | Parse character entity. -characterReference :: Parsec [Char] st Char +characterReference :: Parser [Char] st Char characterReference = try $ do char '&' ent <- many1Till nonspaceChar (char ';') @@ -410,19 +410,19 @@ characterReference = try $ do Nothing -> fail "entity not found" -- | Parses an uppercase roman numeral and returns (UpperRoman, number). -upperRoman :: Parsec [Char] st (ListNumberStyle, Int) +upperRoman :: Parser [Char] st (ListNumberStyle, Int) upperRoman = do num <- romanNumeral True return (UpperRoman, num) -- | Parses a lowercase roman numeral and returns (LowerRoman, number). -lowerRoman :: Parsec [Char] st (ListNumberStyle, Int) +lowerRoman :: Parser [Char] st (ListNumberStyle, Int) lowerRoman = do num <- romanNumeral False return (LowerRoman, num) -- | Parses a decimal numeral and returns (Decimal, number). -decimal :: Parsec [Char] st (ListNumberStyle, Int) +decimal :: Parser [Char] st (ListNumberStyle, Int) decimal = do num <- many1 digit return (Decimal, read num) @@ -431,7 +431,7 @@ decimal = do -- returns (DefaultStyle, [next example number]). The next -- example number is incremented in parser state, and the label -- (if present) is added to the label table. -exampleNum :: Parsec [Char] ParserState (ListNumberStyle, Int) +exampleNum :: Parser [Char] ParserState (ListNumberStyle, Int) exampleNum = do char '@' lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-')) @@ -445,38 +445,38 @@ exampleNum = do return (Example, num) -- | Parses a '#' returns (DefaultStyle, 1). -defaultNum :: Parsec [Char] st (ListNumberStyle, Int) +defaultNum :: Parser [Char] st (ListNumberStyle, Int) defaultNum = do char '#' return (DefaultStyle, 1) -- | Parses a lowercase letter and returns (LowerAlpha, number). -lowerAlpha :: Parsec [Char] st (ListNumberStyle, Int) +lowerAlpha :: Parser [Char] st (ListNumberStyle, Int) lowerAlpha = do ch <- oneOf ['a'..'z'] return (LowerAlpha, ord ch - ord 'a' + 1) -- | Parses an uppercase letter and returns (UpperAlpha, number). -upperAlpha :: Parsec [Char] st (ListNumberStyle, Int) +upperAlpha :: Parser [Char] st (ListNumberStyle, Int) upperAlpha = do ch <- oneOf ['A'..'Z'] return (UpperAlpha, ord ch - ord 'A' + 1) -- | Parses a roman numeral i or I -romanOne :: Parsec [Char] st (ListNumberStyle, Int) +romanOne :: Parser [Char] st (ListNumberStyle, Int) romanOne = (char 'i' >> return (LowerRoman, 1)) <|> (char 'I' >> return (UpperRoman, 1)) -- | Parses an ordered list marker and returns list attributes. -anyOrderedListMarker :: Parsec [Char] ParserState ListAttributes +anyOrderedListMarker :: Parser [Char] ParserState ListAttributes anyOrderedListMarker = choice $ [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens], numParser <- [decimal, exampleNum, defaultNum, romanOne, lowerAlpha, lowerRoman, upperAlpha, upperRoman]] -- | Parses a list number (num) followed by a period, returns list attributes. -inPeriod :: Parsec [Char] st (ListNumberStyle, Int) - -> Parsec [Char] st ListAttributes +inPeriod :: Parser [Char] st (ListNumberStyle, Int) + -> Parser [Char] st ListAttributes inPeriod num = try $ do (style, start) <- num char '.' @@ -486,16 +486,16 @@ inPeriod num = try $ do return (start, style, delim) -- | Parses a list number (num) followed by a paren, returns list attributes. -inOneParen :: Parsec [Char] st (ListNumberStyle, Int) - -> Parsec [Char] st ListAttributes +inOneParen :: Parser [Char] st (ListNumberStyle, Int) + -> Parser [Char] st ListAttributes inOneParen num = try $ do (style, start) <- num char ')' return (start, style, OneParen) -- | Parses a list number (num) enclosed in parens, returns list attributes. -inTwoParens :: Parsec [Char] st (ListNumberStyle, Int) - -> Parsec [Char] st ListAttributes +inTwoParens :: Parser [Char] st (ListNumberStyle, Int) + -> Parser [Char] st ListAttributes inTwoParens num = try $ do char '(' (style, start) <- num @@ -506,7 +506,7 @@ inTwoParens num = try $ do -- returns number. orderedListMarker :: ListNumberStyle -> ListNumberDelim - -> Parsec [Char] ParserState Int + -> Parser [Char] ParserState Int orderedListMarker style delim = do let num = defaultNum <|> -- # can continue any kind of list case style of @@ -526,18 +526,18 @@ orderedListMarker style delim = do return start -- | Parses a character reference and returns a Str element. -charRef :: Parsec [Char] st Inline +charRef :: Parser [Char] st Inline charRef = do c <- characterReference return $ Str [c] -- | Parse a table using 'headerParser', 'rowParser', -- 'lineParser', and 'footerParser'. -tableWith :: Parsec [Char] ParserState ([[Block]], [Alignment], [Int]) - -> ([Int] -> Parsec [Char] ParserState [[Block]]) - -> Parsec [Char] ParserState sep - -> Parsec [Char] ParserState end - -> Parsec [Char] ParserState Block +tableWith :: Parser [Char] ParserState ([[Block]], [Alignment], [Int]) + -> ([Int] -> Parser [Char] ParserState [[Block]]) + -> Parser [Char] ParserState sep + -> Parser [Char] ParserState end + -> Parser [Char] ParserState Block tableWith headerParser rowParser lineParser footerParser = try $ do (heads, aligns, indices) <- headerParser lines' <- rowParser indices `sepEndBy1` lineParser @@ -579,9 +579,9 @@ widthsFromIndices numColumns' indices = -- (which may be grid), then the rows, -- which may be grid, separated by blank lines, and -- ending with a footer (dashed line followed by blank line). -gridTableWith :: Parsec [Char] ParserState Block -- ^ Block parser +gridTableWith :: Parser [Char] ParserState Block -- ^ Block parser -> Bool -- ^ Headerless table - -> Parsec [Char] ParserState Block + -> Parser [Char] ParserState Block gridTableWith block headless = tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter @@ -589,13 +589,13 @@ gridTableSplitLine :: [Int] -> String -> [String] gridTableSplitLine indices line = map removeFinalBar $ tail $ splitStringByIndices (init indices) $ removeTrailingSpace line -gridPart :: Char -> Parsec [Char] st (Int, Int) +gridPart :: Char -> Parser [Char] st (Int, Int) gridPart ch = do dashes <- many1 (char ch) char '+' return (length dashes, length dashes + 1) -gridDashedLines :: Char -> Parsec [Char] st [(Int,Int)] +gridDashedLines :: Char -> Parser [Char] st [(Int,Int)] gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline removeFinalBar :: String -> String @@ -603,13 +603,13 @@ removeFinalBar = reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse -- | Separator between rows of grid table. -gridTableSep :: Char -> Parsec [Char] ParserState Char +gridTableSep :: Char -> Parser [Char] ParserState Char gridTableSep ch = try $ gridDashedLines ch >> return '\n' -- | Parse header for a grid table. gridTableHeader :: Bool -- ^ Headerless table - -> Parsec [Char] ParserState Block - -> Parsec [Char] ParserState ([[Block]], [Alignment], [Int]) + -> Parser [Char] ParserState Block + -> Parser [Char] ParserState ([[Block]], [Alignment], [Int]) gridTableHeader headless block = try $ do optional blanklines dashes <- gridDashedLines '-' @@ -633,16 +633,16 @@ gridTableHeader headless block = try $ do map removeLeadingTrailingSpace rawHeads return (heads, aligns, indices) -gridTableRawLine :: [Int] -> Parsec [Char] ParserState [String] +gridTableRawLine :: [Int] -> Parser [Char] ParserState [String] gridTableRawLine indices = do char '|' line <- many1Till anyChar newline return (gridTableSplitLine indices line) -- | Parse row of grid table. -gridTableRow :: Parsec [Char] ParserState Block +gridTableRow :: Parser [Char] ParserState Block -> [Int] - -> Parsec [Char] ParserState [[Block]] + -> Parser [Char] ParserState [[Block]] gridTableRow block indices = do colLines <- many1 (gridTableRawLine indices) let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $ @@ -661,13 +661,13 @@ compactifyCell :: [Block] -> [Block] compactifyCell bs = head $ compactify [bs] -- | Parse footer for a grid table. -gridTableFooter :: Parsec [Char] ParserState [Char] +gridTableFooter :: Parser [Char] ParserState [Char] gridTableFooter = blanklines --- -- | Parse a string with a given parser and state. -readWith :: Parsec [t] ParserState a -- ^ parser +readWith :: Parser [t] ParserState a -- ^ parser -> ParserState -- ^ initial state -> [t] -- ^ input -> a @@ -677,7 +677,7 @@ readWith parser state input = Right result -> result -- | Parse a string with @parser@ (for testing). -testStringWith :: (Show a) => Parsec [Char] ParserState a +testStringWith :: (Show a) => Parser [Char] ParserState a -> String -> IO () testStringWith parser str = UTF8.putStrLn $ show $ @@ -781,25 +781,25 @@ lookupKeySrc table key = case M.lookup key table of Just src -> Just src -- | Fail unless we're in "smart typography" mode. -failUnlessSmart :: Parsec [tok] ParserState () +failUnlessSmart :: Parser [tok] ParserState () failUnlessSmart = getOption readerSmart >>= guard -smartPunctuation :: Parsec [Char] ParserState Inline - -> Parsec [Char] ParserState Inline +smartPunctuation :: Parser [Char] ParserState Inline + -> Parser [Char] ParserState Inline smartPunctuation inlineParser = do failUnlessSmart choice [ quoted inlineParser, apostrophe, dash, ellipses ] -apostrophe :: Parsec [Char] ParserState Inline +apostrophe :: Parser [Char] ParserState Inline apostrophe = (char '\'' <|> char '\8217') >> return (Str "\x2019") -quoted :: Parsec [Char] ParserState Inline - -> Parsec [Char] ParserState Inline +quoted :: Parser [Char] ParserState Inline + -> Parser [Char] ParserState Inline quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser withQuoteContext :: QuoteContext - -> (Parsec [Char] ParserState Inline) - -> Parsec [Char] ParserState Inline + -> (Parser [Char] ParserState Inline) + -> Parser [Char] ParserState Inline withQuoteContext context parser = do oldState <- getState let oldQuoteContext = stateQuoteContext oldState @@ -809,39 +809,39 @@ withQuoteContext context parser = do setState newState { stateQuoteContext = oldQuoteContext } return result -singleQuoted :: Parsec [Char] ParserState Inline - -> Parsec [Char] ParserState Inline +singleQuoted :: Parser [Char] ParserState Inline + -> Parser [Char] ParserState Inline singleQuoted inlineParser = try $ do singleQuoteStart withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>= return . Quoted SingleQuote . normalizeSpaces -doubleQuoted :: Parsec [Char] ParserState Inline - -> Parsec [Char] ParserState Inline +doubleQuoted :: Parser [Char] ParserState Inline + -> Parser [Char] ParserState Inline doubleQuoted inlineParser = try $ do doubleQuoteStart withQuoteContext InDoubleQuote $ do contents <- manyTill inlineParser doubleQuoteEnd return . Quoted DoubleQuote . normalizeSpaces $ contents -failIfInQuoteContext :: QuoteContext -> Parsec [tok] ParserState () +failIfInQuoteContext :: QuoteContext -> Parser [tok] ParserState () failIfInQuoteContext context = do st <- getState if stateQuoteContext st == context then fail "already inside quotes" else return () -charOrRef :: [Char] -> Parsec [Char] st Char +charOrRef :: [Char] -> Parser [Char] st Char charOrRef cs = oneOf cs <|> try (do c <- characterReference guard (c `elem` cs) return c) -updateLastStrPos :: Parsec [Char] ParserState () +updateLastStrPos :: Parser [Char] ParserState () updateLastStrPos = getPosition >>= \p -> updateState $ \s -> s{ stateLastStrPos = Just p } -singleQuoteStart :: Parsec [Char] ParserState () +singleQuoteStart :: Parser [Char] ParserState () singleQuoteStart = do failIfInQuoteContext InSingleQuote pos <- getPosition @@ -856,28 +856,28 @@ singleQuoteStart = do -- possess/contraction return () -singleQuoteEnd :: Parsec [Char] st () +singleQuoteEnd :: Parser [Char] st () singleQuoteEnd = try $ do charOrRef "'\8217\146" notFollowedBy alphaNum -doubleQuoteStart :: Parsec [Char] ParserState () +doubleQuoteStart :: Parser [Char] ParserState () doubleQuoteStart = do failIfInQuoteContext InDoubleQuote try $ do charOrRef "\"\8220\147" notFollowedBy (satisfy (\c -> c == ' ' || c == '\t' || c == '\n')) -doubleQuoteEnd :: Parsec [Char] st () +doubleQuoteEnd :: Parser [Char] st () doubleQuoteEnd = do charOrRef "\"\8221\148" return () -ellipses :: Parsec [Char] st Inline +ellipses :: Parser [Char] st Inline ellipses = do try (charOrRef "\8230\133") <|> try (string "..." >> return '…') return (Str "\8230") -dash :: Parsec [Char] ParserState Inline +dash :: Parser [Char] ParserState Inline dash = do oldDashes <- getOption readerOldDashes if oldDashes @@ -885,28 +885,28 @@ dash = do else Str `fmap` (hyphenDash <|> emDash <|> enDash) -- Two hyphens = en-dash, three = em-dash -hyphenDash :: Parsec [Char] st String +hyphenDash :: Parser [Char] st String hyphenDash = do try $ string "--" option "\8211" (char '-' >> return "\8212") -emDash :: Parsec [Char] st String +emDash :: Parser [Char] st String emDash = do try (charOrRef "\8212\151") return "\8212" -enDash :: Parsec [Char] st String +enDash :: Parser [Char] st String enDash = do try (charOrRef "\8212\151") return "\8211" -enDashOld :: Parsec [Char] st Inline +enDashOld :: Parser [Char] st Inline enDashOld = do try (charOrRef "\8211\150") <|> try (char '-' >> lookAhead (satisfy isDigit) >> return '–') return (Str "\8211") -emDashOld :: Parsec [Char] st Inline +emDashOld :: Parser [Char] st Inline emDashOld = do try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-') return (Str "\8212") @@ -916,7 +916,7 @@ emDashOld = do -- -- | Parse a \newcommand or \renewcommand macro definition. -macro :: Parsec [Char] ParserState Block +macro :: Parser [Char] ParserState Block macro = do apply <- getOption readerApplyMacros inp <- getInput @@ -931,7 +931,7 @@ macro = do else return $ RawBlock "latex" def' -- | Apply current macros to string. -applyMacros' :: String -> Parsec [Char] ParserState String +applyMacros' :: String -> Parser [Char] ParserState String applyMacros' target = do apply <- getOption readerApplyMacros if apply @@ -939,3 +939,44 @@ applyMacros' target = do return $ applyMacros macros target else return target +---- pandoc2 block sep/line end parsers +{- + +-- | Push parser onto stack of endline parsers. +-- These are applied after a newline within a block. +pushEndline :: PMonad m => P t m () -> P t m () +pushEndline p = modifyState $ \st -> st{ sEndline = sEndline st |> p } + +-- | Pop parser off stack of endline parsers. +popEndline :: PMonad m => P t m () +popEndline = do + st <- getState + case viewr (sEndline st) of + EmptyR -> logM ERROR "Tried to pop empty pEndline stack" + ps :> _ -> setState st{ sEndline = ps } + +-- | Apply a parser in a context with a specified endline parser. +withEndline :: PMonad m => P t m a -> P t m b -> P t m b +withEndline sep p = pushEndline (() <$ sep) *> p <* popEndline + +-- | Push parser onto stack of block separator parsers. +-- These are applied after a newline following a block. +pushBlockSep :: PMonad m => P t m () -> P t m () +pushBlockSep p = modifyState $ \st -> st{ sBlockSep = sBlockSep st |> p } + +-- | Pop parser off of stack of block separator parsers. +popBlockSep :: PMonad m => P t m () +popBlockSep = do + st <- getState + case viewr (sBlockSep st) of + EmptyR -> logM ERROR "Tried to pop empty pBlockSep stack" + ps :> _ -> setState st{ sBlockSep = ps } + +-- | Apply a parser in a context with specified block separator parser. +withBlockSep :: PMonad m => P t m a -> P t m b -> P t m b +withBlockSep sep p = pushBlockSep (() <$ sep) *> p <* popBlockSep + +-- | Parse a block separator. +pBlockSep :: PMonad m => P t m () +pBlockSep = try (getState >>= sequenceA . sBlockSep) >> return () +-} |