[#107] Parse nested comments

src/Extensions/Module.hs

@@ -26,7 +26,7 @@ import Data.ByteString (ByteString)
 import Data.Char (toLower, toUpper)
 import Data.Either (partitionEithers)
 import Data.Foldable (traverse_)
-import Data.Functor ((<&>))
+import Data.Functor ((<&>), void)
 import Data.List (nub)
 import Data.List.NonEmpty (NonEmpty (..))
 import System.Directory (doesFileExist)
@@ -109,8 +109,8 @@ extensionsP :: Parser [ParsedExtension]
 extensionsP = concat <$>
     ( newLines *>
       manyTill
-        (try singleExtensionsP <|> try optionsGhcP <|> try commentP <|> try cppP)
-        (eof <|> (() <$ manyTill endOfLine letter))
+        (try singleExtensionsP <|> try optionsGhcP <|> [] <$ try commentP <|> try cppP)
+        (eof <|> void (manyTill endOfLine letter))
     )
 
 {- | Single LANGUAGE pragma parser.
@@ -186,16 +186,16 @@ and multi-line comments:
   \-\}
   @
 -}
-commentP :: Parser [a]
+commentP :: Parser String
 commentP = newLines *> (try singleLineCommentP <|> try multiLineCommentP) <* newLines
   where
-    singleLineCommentP :: Parser [a]
-    singleLineCommentP = [] <$
-        (string "--" *> manyTill anyChar (try (() <$ endOfLine) <|> eof))
+    singleLineCommentP :: Parser String
+    singleLineCommentP =
+        string "--" *> manyTill anyChar (try (void endOfLine) <|> eof)
 
-    multiLineCommentP :: Parser [a]
-    multiLineCommentP = [] <$
-        (string "{-" *> manyTill anyChar (try $ string "-}"))
+    multiLineCommentP :: Parser String
+    multiLineCommentP =
+        concat <$> (string "{-" *> manyTill (try multiLineCommentP <|> (: []) <$> anyChar) (try (string "-}")))
 
 {- | CPP syntax parser.
 

test/Test/Extensions/Module.hs

@@ -420,6 +420,9 @@ mixSpec = describe "Parsing combinations of different parts" $ do
             { parsedExtensionsAll  = [On Cpp]
             , parsedExtensionsSafe = Just Trustworthy
             }
+    itShouldParse "{- {- -} -}" []
+    itShouldParse "{- {-# LANGUAGE LambdaCase #-} -}" []
+    itShouldParse "{-# LANGUAGE LambdaCase {- -} #-}" [LambdaCase]
 
 itShouldParse :: String -> [Extension] -> SpecWith (Arg Expectation)
 itShouldParse s = itShouldParseOnOff s . map On