Always handle "completion/resolve" requests

Resolves the LSP "completion/resolve" requests, even if there is nothing
more to resolve.
If there is nothing to resolve, we simply return the initial completion
item.

If we reject "completion/resolve" requests, then some LSP clients show
our rejection as pop-ups which are hugely distracting.

We change completion tests to always resolve completions, regardless of
the existence of `_data_`, as this seems to be the behaviour of VSCode.

Author: fendor

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -127,6 +127,7 @@ dropListFromImportDecl iDecl = let
     in f <$> iDecl
 
 resolveCompletion :: ResolveFunction IdeState CompletionResolveData Method_CompletionItemResolve
+resolveCompletion _ide _pid comp _uri NothingToResolve = pure comp
 resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} uri (CompletionResolveData _ needType (NameDetails mod occ)) =
   do
     file <- getNormalizedFilePathE uri

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -229,7 +229,9 @@ mkCompl
                   _additionalTextEdits = Nothing,
                   _commitCharacters = Nothing,
                   _command = mbCommand,
-                  _data_ = toJSON <$> fmap (CompletionResolveData uri (isNothing typeText)) nameDetails,
+                  _data_ = Just $ toJSON $ case nameDetails of
+                    Nothing ->  NothingToResolve
+                    Just nameDets -> CompletionResolveData uri (isNothing typeText) nameDets,
                   _labelDetails = Nothing,
                   _textEditText = Nothing}
   removeSnippetsWhen (isJust isInfix) ci
@@ -309,7 +311,7 @@ mkExtCompl label =
 defaultCompletionItemWithLabel :: T.Text -> CompletionItem
 defaultCompletionItemWithLabel label =
     CompletionItem label def def def def def def def def def
-                         def def def def def def def def def
+                         def def def def def def def def (Just $ toJSON NothingToResolve)
 
 fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
 fromIdentInfo doc identInfo@IdentInfo{..} q = CI

ghcide/src/Development/IDE/Plugin/Completions/Types.hs

@@ -199,10 +199,19 @@ instance Show NameDetails where
 -- | The data that is actually sent for resolve support
 -- We need the URI to be able to reconstruct the GHC environment
 -- in the file the completion was triggered in.
-data CompletionResolveData = CompletionResolveData
-  { itemFile      :: Uri
-  , itemNeedsType :: Bool -- ^ Do we need to lookup a type for this item?
-  , itemName      :: NameDetails
-  }
+data CompletionResolveData
+  = NothingToResolve
+    -- ^ The client requested to resolve a completion, but there is nothing to resolve,
+    -- as we can't add any additional information, such as docs.
+    -- We still handle these requests, otherwise HLS will reject "completion/resolve" requests
+    -- which present on some clients (e.g., emacs) as an error message.
+    -- See https://github.com/haskell/haskell-language-server/issues/4451 for the issue that
+    -- triggered this change.
+  | CompletionResolveData
+    -- ^ Data that we use to handle "completion/resolve" requests.
+    { itemFile      :: Uri
+    , itemNeedsType :: Bool -- ^ Do we need to lookup a type for this item?
+    , itemName      :: NameDetails
+    }
   deriving stock Generic
   deriving anyclass (FromJSON, ToJSON)

ghcide/test/exe/CompletionTests.hs

@@ -557,19 +557,24 @@ completionDocTests =
         ]
       let expected = "*Imported from 'Prelude'*\n"
       test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
+  , testSessionEmpty "defined in where clause" $ do
+      doc <- createDoc "A.hs" "haskell" $ T.unlines
+        [ "module A where"
+        , "bar = foo"
+        , " where foobar = 5"
+        ]
+      let expected = "*Defined at line 3, column"
+      test doc (Position 1 9) "foobar" (Just $ T.length expected) [expected]
   ]
   where
     test doc pos label mn expected = do
       _ <- waitForDiagnostics
       compls <- getCompletions doc pos
       rcompls <- forM compls $ \item -> do
-            if isJust (item ^. L.data_)
-            then do
-                rsp <- request SMethod_CompletionItemResolve item
-                case rsp ^. L.result of
-                    Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)
-                    Right x -> pure x
-            else pure item
+        rsp <- request SMethod_CompletionItemResolve item
+        case rsp ^. L.result of
+            Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)
+            Right x -> pure x
       let compls' = [
             -- We ignore doc uris since it points to the local path which determined by specific machines
             case mn of