Import suggestion for missing newtype constructor, all types constructor and indirect overloadedrecorddot fields

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -1840,6 +1840,34 @@ extractNotInScopeName x
   = Just $ NotInScopeDataConstructor name
   | Just [name] <- matchRegexUnifySpaces x "ot in scope: type constructor or class [^‘]*‘([^’]*)’"
   = Just $ NotInScopeTypeConstructorOrClass name
+  | Just [name] <- matchRegexUnifySpaces x "The data constructors of ‘([^ ]+)’ are not all in scope"
+  = Just $ NotInScopeDataConstructor name
+  | Just [name] <- matchRegexUnifySpaces x "of newtype ‘([^’]*)’ is not in scope"
+  = Just $ NotInScopeThing name
+  -- Match for HasField "foo" Bar String in the context where, e.g. x.foo is
+  -- used, and x :: Bar.
+  --
+  -- This usually mean that the field is not in scope and the correct fix is to
+  -- import (Bar(foo)) or (Bar(..)).
+  --
+  -- However, it is more reliable to match for the type name instead of the field
+  -- name, and most of the time you'll want to import the complete type with all
+  -- their fields instead of the specific field.
+  --
+  -- The regex is convoluted because it accounts for:
+  --
+  -- - Qualified (or not) `HasField`
+  -- - The type bar is always qualified. If it is unqualified, it means that the
+  -- parent module is already imported, and in this context it uses an hint
+  -- already available in the GHC error message. However this regex accounts for
+  -- qualified or not, it does not cost much and should be more robust if the
+  -- hint changes in the future
+  -- - Next regex will account for polymorphic types, which appears as `HasField
+  -- "foo" (Bar Int)...`, e.g. see the parenthesis
+  | Just [_module, name] <- matchRegexUnifySpaces x "No instance for [‘(].*HasField \"[^\"]+\" ([^ (.]+\\.)*([^ (.]+).*[’)]"
+  = Just $ NotInScopeThing name
+  | Just [_module, name] <- matchRegexUnifySpaces x "No instance for [‘(].*HasField \"[^\"]+\" \\(([^ .]+\\.)*([^ .]+)[^)]*\\).*[’)]"
+  = Just $ NotInScopeThing name
   | Just [name] <- matchRegexUnifySpaces x "ot in scope: \\(([^‘ ]+)\\)"
   = Just $ NotInScopeThing name
   | Just [name] <- matchRegexUnifySpaces x "ot in scope: ([^‘ ]+)"

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs

@@ -21,6 +21,9 @@ matchRegex message regex = case message =~~ regex of
     Nothing                                                -> Nothing
 
 -- | 'matchRegex' combined with 'unifySpaces'
+--
+-- >>> matchRegexUnifySpaces  "hello I'm a cow" "he(ll)o"
+-- Just ["ll"]
 matchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [T.Text]
 matchRegexUnifySpaces message = matchRegex (unifySpaces message)
 

plugins/hls-refactor-plugin/test/Main.hs

@@ -300,6 +300,8 @@ codeActionTests = testGroup "code actions"
   , suggestImportClassMethodTests
   , suggestImportTests
   , suggestAddRecordFieldImportTests
+  , suggestAddCoerceMissingConstructorImportTests
+  , suggestAddGenericMissingConstructorImportTests
   , suggestHideShadowTests
   , fixConstructorImportTests
   , fixModuleImportTypoTests
@@ -1849,8 +1851,14 @@ suggestImportTests = testGroup "suggest import actions"
 suggestAddRecordFieldImportTests :: TestTree
 suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields when using OverloadedRecordDot"
   [ testGroup "The field is suggested when an instance resolution failure occurs"
-    [ ignoreForGhcVersions [GHC94, GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest
+    ([ ignoreForGhcVersions [GHC94, GHC96] "Extension not present <9.2, and the assist is derived from the help message in >=9.4" theTest
     ]
+    ++ [
+        theTestIndirect qualifiedGhcRecords polymorphicType
+        |
+        qualifiedGhcRecords <- [False, True]
+        , polymorphicType <- [False, True]
+        ])
   ]
   where
     theTest = testSessionWithExtraFiles "hover" def $ \dir -> do
@@ -1871,6 +1879,83 @@ suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields w
       contentAfterAction <- documentContents doc
       liftIO $ after @=? contentAfterAction
 
+    theTestIndirect qualifiedGhcRecords polymorphicType = testGroup
+      ((if qualifiedGhcRecords then "qualified-" else "unqualified-")
+      <> ("HasField " :: String)
+      <>
+      (if polymorphicType then "polymorphic-" else "monomorphic-")
+      <> "type ")
+      . (\x -> [x]) $ testSessionWithExtraFiles "hover" def $ \dir -> do
+      -- Hopefully enable project indexing?
+      configureCheckProject True
+
+      let
+          before = T.unlines ["{-# LANGUAGE OverloadedRecordDot #-}", "module A where", if qualifiedGhcRecords then "" else "import GHC.Records", "import C (bar)", "spam = bar.foo"]
+          after = T.unlines ["{-# LANGUAGE OverloadedRecordDot #-}", "module A where", if qualifiedGhcRecords then "" else "import GHC.Records", "import C (bar)", "import B (Foo(..))", "spam = bar.foo"]
+          cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, B, C]}}"
+      liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
+      liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["module B where", if polymorphicType then "data Foo x = Foo { foo :: x }" else "data Foo = Foo { foo :: Int }"]
+      liftIO $ writeFileUTF8 (dir </> "C.hs") $ unlines ["module C where", "import B", "bar = Foo 10" ]
+      doc <- createDoc "Test.hs" "haskell" before
+      waitForProgressDone
+      _ <- waitForDiagnostics
+      let defLine = 4
+          range = Range (Position defLine 0) (Position defLine maxBound)
+      actions <- getCodeActions doc range
+      action <- pickActionWithTitle "import B (Foo(..))" actions
+      executeCodeAction action
+      contentAfterAction <- documentContents doc
+      liftIO $ after @=? contentAfterAction
+
+suggestAddCoerceMissingConstructorImportTests :: TestTree
+suggestAddCoerceMissingConstructorImportTests = testGroup "suggest imports of newtype constructor when using coerce"
+  [ testGroup "The newtype constructor is suggested when a matching representation error"
+    [ theTest
+    ]
+  ]
+  where
+    theTest = testSessionWithExtraFiles "hover" def $ \dir -> do
+      configureCheckProject False
+      let before = T.unlines ["module A where", "import Data.Coerce (coerce)", "import Data.Semigroup (Sum)", "bar = coerce (10 :: Int) :: Sum Int"]
+          after = T.unlines ["module A where", "import Data.Coerce (coerce)", "import Data.Semigroup (Sum)", "import Data.Semigroup (Sum(..))", "bar = coerce (10 :: Int) :: Sum Int"]
+          cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A]}}"
+      liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
+      doc <- createDoc "Test.hs" "haskell" before
+      waitForProgressDone
+      _ <- waitForDiagnostics
+      let defLine = 3
+          range = Range (Position defLine 0) (Position defLine maxBound)
+      actions <- getCodeActions doc range
+      action <- pickActionWithTitle "import Data.Semigroup (Sum(..))" actions
+      executeCodeAction action
+      contentAfterAction <- documentContents doc
+      liftIO $ after @=? contentAfterAction
+
+suggestAddGenericMissingConstructorImportTests :: TestTree
+suggestAddGenericMissingConstructorImportTests = testGroup "suggest imports of type constructors when using generic deriving"
+  [ testGroup "The type constructors are suggested when not in scope"
+    [ theTest
+    ]
+  ]
+  where
+    theTest = testSessionWithExtraFiles "hover" def $ \dir -> do
+      configureCheckProject False
+      let
+          before = T.unlines ["module A where", "import GHC.Generics", "import Data.Semigroup (Sum)", "deriving instance Generic (Sum Int)"]
+          after = T.unlines ["module A where", "import GHC.Generics", "import Data.Semigroup (Sum)", "import Data.Semigroup (Sum(..))", "deriving instance Generic (Sum Int)"]
+          cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A]}}"
+      liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
+      doc <- createDoc "Test.hs" "haskell" before
+      waitForProgressDone
+      _ <- waitForDiagnostics
+      let defLine = 3
+          range = Range (Position defLine 0) (Position defLine maxBound)
+      actions <- getCodeActions doc range
+      action <- pickActionWithTitle "import Data.Semigroup (Sum(..))" actions
+      executeCodeAction action
+      contentAfterAction <- documentContents doc
+      liftIO $ after @=? contentAfterAction
+
 
 suggestImportDisambiguationTests :: TestTree
 suggestImportDisambiguationTests = testGroup "suggest import disambiguation actions"