diff --git a/CHANGELOG.md b/CHANGELOG.md index 9a050cd..1fde48d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,9 @@ makes `signed` parser more natural and general, because we do not need ad-hoc `Signed` type class anymore. +* Added `skipBlockCommentNested` function that should help parse possibly + nested block comments. + ## Megaparsec 4.4.0 * Now state returned on failure is the exact state of parser at the moment diff --git a/Text/Megaparsec/Lexer.hs b/Text/Megaparsec/Lexer.hs index 00ca1dc..1509cf9 100644 --- a/Text/Megaparsec/Lexer.hs +++ b/Text/Megaparsec/Lexer.hs @@ -26,6 +26,7 @@ module Text.Megaparsec.Lexer , symbol' , skipLineComment , skipBlockComment + , skipBlockCommentNested -- * Indentation , indentLevel , indentGuard @@ -162,6 +163,20 @@ skipBlockComment start end = p >> void (manyTill C.anyChar n) where p = C.string start n = C.string end +-- | @skipBlockCommentNested start end@ skips possibly nested block comment +-- starting with @start@ and ending with @end@. +-- +-- @since 5.0.0 + +skipBlockCommentNested :: MonadParsec s m Char + => String -- ^ Start of block comment + -> String -- ^ End of block comment + -> m () +skipBlockCommentNested start end = p >> void (manyTill e n) + where e = skipBlockCommentNested start end <|> void C.anyChar + p = C.string start + n = C.string end + ---------------------------------------------------------------------------- -- Indentation diff --git a/tests/Lexer.hs b/tests/Lexer.hs index c2d72f7..39c53b0 100644 --- a/tests/Lexer.hs +++ b/tests/Lexer.hs @@ -45,7 +45,9 @@ import Data.Scientific (fromFloatDigits) import Numeric (showInt, showHex, showOct, showSigned) import Test.Framework +import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (Assertion) import Test.QuickCheck import Text.Megaparsec.Error @@ -67,6 +69,7 @@ tests = testGroup "Lexer" [ testProperty "space combinator" prop_space , testProperty "symbol combinator" prop_symbol , testProperty "symbol' combinator" prop_symbol' + , testCase "skipBlockCommentNested" prop_skipBlockCommentNested , testProperty "indentLevel" prop_indentLevel , testProperty "indentGuard combinator" prop_indentGuard , testProperty "nonIndented combinator" prop_nonIndented @@ -154,6 +157,14 @@ parseSymbol p' f s' t = checkParser p r s g = takeWhile (not . isSpace) s s = s' ++ maybeToList t +prop_skipBlockCommentNested :: Assertion +prop_skipBlockCommentNested = checkCase p r s + where p :: MonadParsec s m Char => m () + p = space (void C.spaceChar) empty + (skipBlockCommentNested "/*" "*/") <* eof + r = Right () + s = " /* foo bar /* baz */ quux */ " + -- Indentation prop_indentLevel :: SourcePos -> Property