From 79dd2d9e6842d7bf2ff1a3cf5437554c9e0a64f8 Mon Sep 17 00:00:00 2001
From: Peter Wicks Stringfield <peterwicksstringfield@gmail.com>
Date: Thu, 17 Jun 2021 20:55:30 -0500
Subject: [PATCH] Don't suggest import an unnecessary data constructor.

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.
---
 .../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 3c0db29088..6346b85a56 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)"