Fix cabal info parser issue

Author: pbrinkmeier

haskell-language-server.cabal

@@ -308,6 +308,7 @@ test-suite hls-cabal-plugin-tests
     , base
     , bytestring
     , Cabal-syntax          >= 3.7
+    , containers
     , extra
     , filepath
     , ghcide

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalInfoParser.hs

@@ -6,10 +6,10 @@ module Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo, cabalInfo) where
 import           Data.Map.Strict   (Map)
 import           Data.Text         (Text)
 import           Data.Void         (Void)
-import           Text.Megaparsec   (MonadParsec (..), Parsec, chunk, many,
-                                    parse, sepBy, single, (<|>))
+import           Text.Megaparsec   (MonadParsec (..), Parsec, chunk, failure,
+                                    many, parse, single, (<|>))
 
-import           Control.Monad     (void)
+import           Control.Monad     (void, when)
 import           Data.Either.Extra (mapLeft)
 import qualified Data.Map.Strict   as Map
 import qualified Data.Text         as T
@@ -21,11 +21,9 @@ parseCabalInfo = mapLeft (T.pack . show) . parse cabalInfo ""
 
 type CabalInfoParserError = Text
 
--- TODO: parse eof at the end to avoid early exits
 cabalInfo :: Parser (Map Text (Map Text [Text]))
 cabalInfo = do
-    entries <- cabalInfoEntry `sepBy` chunk "\n\n"
-    void $ takeWhileP (Just "trailing whitespace") (`elem` (" \t\r\n" :: String))
+    entries <- many $ try cabalInfoEntry
     eof
 
     pure $ Map.fromList entries
@@ -39,13 +37,18 @@ cabalInfoEntry = do
 
     void restOfLine
 
-    pairs <- many $ try kvPair
+    pairs <- many $ try field
+
+    void $ takeWhileP (Just "trailing whitespace") (`elem` (" \t\r\n" :: String))
 
     pure (name, Map.fromList pairs)
 
-kvPair :: Parser (Text, [Text])
-kvPair = do
+field :: Parser (Text, [Text])
+field = do
     spacesBeforeKey <- spaces
+    -- We assume that all fields are indented ==> fail if that ain't so.
+    when (T.null spacesBeforeKey) $ failure Nothing mempty
+
     key <- takeWhileP (Just "field name") (/= ':')
     void $ single ':'
     spacesAfterKey <- spaces

plugins/hls-cabal-plugin/test/CabalInfoParser.hs

@@ -1,20 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module CabalInfoParser (cabalInfoParserUnitTests) where
 
 import           System.FilePath                  ((</>))
-import           Test.Hls                         (TestTree, testCase,
-                                                   testGroup, (@?))
+import           Test.Hls                         (Assertion, TestTree,
+                                                   assertFailure, testCase,
+                                                   testGroup, (@=?), (@?))
 import           Utils                            (testDataDir)
 
 import qualified Data.Text.IO                     as TIO
 
 import           Data.Either                      (isRight)
 import           Ide.Plugin.Cabal.CabalInfoParser (parseCabalInfo)
 
+import           Data.Map.Strict                  (Map)
+import qualified Data.Map.Strict                  as Map
+import           Data.Text                        (Text)
+
 cabalInfoParserUnitTests :: TestTree
 cabalInfoParserUnitTests = testGroup "cabal info Parser Tests"
     [ simpleParsingWorks
+    , simpleMultiEntryParsingWorks
     ]
     where
-        simpleParsingWorks = testCase "Simple parsing works" $ do
-            res <- parseCabalInfo <$> TIO.readFile (testDataDir </> "cabal-info" </> "text.cabal-info")
-            isRight res @? "Failed to parse well-formed input"
+        simpleParsingWorks =
+            testCase "Simple parsing works" $ testParserWithFile "text.cabal-info" $ \ci -> do
+                Map.keys ci @=? ["text"]
+
+        simpleMultiEntryParsingWorks =
+            testCase "Simple parsing works for multiple packages" $ testParserWithFile "containers-base.cabal-info" $ \ci -> do
+                Map.keys ci @=? ["base", "containers"]
+
+testParserWithFile :: FilePath -> (Map Text (Map Text [Text]) -> Assertion) -> Assertion
+testParserWithFile file f = do
+    res <- parseCabalInfo <$> TIO.readFile (testDataDir </> "cabal-info" </> file)
+    case res of
+        Left _   -> assertFailure "Failed to parse well-formed input"
+        Right ci -> f ci