Add import suggestion for indirect overloaded record dot

For example, the following code `foo.titi` when the type of `foo` (e.g.
`Bar` here is not in scope and not from an already imported module (e.g.
the type exists indirectly because here `foo :: Bar` comes from another module).

If the module which contains `Bar` is already imported, GHC already
gives an hint to add `titi` to the `import Bar` line and this is already
correctly handled by HLS.

```
 No instance for ‘HasField "titi" Bar.Bar String’
    arising from selecting the field ‘titi’
```

Author: guibou

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

@@ -1844,6 +1844,30 @@ extractNotInScopeName x
   = 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

@@ -1851,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
@@ -1873,6 +1879,34 @@ 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"