From 747993e0bbe9eb58e19e035c627854f716b2f6c6 Mon Sep 17 00:00:00 2001
From: mrkkrp <markkarpov@opmbx.org>
Date: Wed, 30 Mar 2016 14:50:35 +0600
Subject: [PATCH] =?UTF-8?q?Add=20=E2=80=98skipBlockCommentNested=E2=80=99?=
 =?UTF-8?q?=20function?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Close #96.
---
 CHANGELOG.md             |  3 +++
 Text/Megaparsec/Lexer.hs | 15 +++++++++++++++
 tests/Lexer.hs           | 11 +++++++++++
 3 files changed, 29 insertions(+)

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