From 8d4406812dc2d1450eb46430e11399302abde19f Mon Sep 17 00:00:00 2001
From: Peter Wicks Stringfield <peterwicksstringfield@gmail.com>
Date: Mon, 28 Jun 2021 03:47:58 -0500
Subject: [PATCH] Don't suggest import an unnecessary data constructor. (#1984)

Usually, when the type constructor is used but the data constructor isn't, we
only suggest importing the type constructor. When the data constructor and type
constructor share the same name we get mixed up and suggest importing both.

The solution is to do a better job filtering out the data cons when we know we
are looking for a type con.

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
---
 .../src/Development/IDE/Plugin/CodeAction.hs  | 11 +++++---
 ghcide/test/exe/Main.hs                       | 27 ++++++++++++++++---
 2 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
index 1f2d478335..9faa7ab4e4 100644
--- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -804,6 +804,10 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
     = mod_srcspan >>= uncurry (suggestions hsmodImports binding)
     | otherwise = []
     where
+        canUseDatacon = case extractNotInScopeName _message of
+                            Just NotInScopeTypeConstructorOrClass{} -> False
+                            _                                       -> True
+
         suggestions decls binding mod srcspan
           | range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
                 [s] -> let x = realSrcSpanToRange s
@@ -823,7 +827,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
           -- Only for the situation that data constructor name is same as type constructor name,
           -- let ident with parent be in front of the one without.
           , sortedMatch <- sortBy (\ident1 ident2 -> parent ident2 `compare` parent ident1) (Set.toList match)
-          , idents <- filter (\ident -> moduleNameText ident == mod) sortedMatch
+          , idents <- filter (\ident -> moduleNameText ident == mod && (canUseDatacon || not (isDatacon ident))) sortedMatch
           , (not . null) idents -- Ensure fallback while `idents` is empty
           , ident <- head idents
           = Just ident
@@ -1318,8 +1322,9 @@ hideImplicitPreludeSymbol :: T.Text -> NewImport
 hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True
 
 canUseIdent :: NotInScope -> IdentInfo -> Bool
-canUseIdent NotInScopeDataConstructor{} = isDatacon
-canUseIdent _                           = const True
+canUseIdent NotInScopeDataConstructor{}        = isDatacon
+canUseIdent NotInScopeTypeConstructorOrClass{} = not . isDatacon
+canUseIdent _                                  = const True
 
 data NotInScope
     = NotInScopeDataConstructor T.Text
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index 8d3cb7d155..d04d6b9e30 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -730,7 +730,7 @@ codeActionTests = testGroup "code actions"
   , typeWildCardActionTests
   , removeImportTests
   , extendImportTests
-  , suggesImportClassMethodTests
+  , suggestImportClassMethodTests
   , suggestImportTests
   , suggestHideShadowTests
   , suggestImportDisambiguationTests
@@ -1436,6 +1436,25 @@ extendImportTests = testGroup "extend import actions"
                     , "f :: Foo"
                     , "f = Foo 1"
                     ])
+        , testSession "type constructor name same as data constructor name, data constructor extraneous" $ template
+            [("ModuleA.hs", T.unlines
+                    [ "module ModuleA where"
+                    , "data Foo = Foo"
+                    ])]
+            ("ModuleB.hs", T.unlines
+                    [ "module ModuleB where"
+                    , "import ModuleA()"
+                    , "f :: Foo"
+                    , "f = undefined"
+                    ])
+            (Range (Position 2 4) (Position 2 6))
+            ["Add Foo to the import list of ModuleA"]
+            (T.unlines
+                    [ "module ModuleB where"
+                    , "import ModuleA(Foo)"
+                    , "f :: Foo"
+                    , "f = undefined"
+                    ])
         ]
       where
         codeActionTitle CodeAction{_title=x} = x
@@ -1486,8 +1505,8 @@ extendImportTestsRegEx = testGroup "regex parsing"
         template message expected = do
             liftIO $ matchRegExMultipleImports message @=? expected
 
-suggesImportClassMethodTests :: TestTree
-suggesImportClassMethodTests =
+suggestImportClassMethodTests :: TestTree
+suggestImportClassMethodTests =
   testGroup
     "suggest import class methods"
     [ testGroup
@@ -1566,6 +1585,8 @@ suggestImportTests = testGroup "suggest import actions"
     , test False []         "f = quickCheck"              []                "import Test.QuickCheck (quickCheck)"
       -- don't omit the parent data type of a constructor
     , test False []         "f ExitSuccess = ()"          []                "import System.Exit (ExitSuccess)"
+      -- don't suggest data constructor when we only need the type
+    , test False []         "f :: Bar"                    []                "import Bar (Bar(Bar))"
     ]
   , testGroup "want suggestion"
     [ wantWait  []          "f = foo"                     []                "import Foo (foo)"