Qualified name

Author: July541

plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs

@@ -36,7 +36,7 @@ import qualified Language.LSP.Types.Lens              as J
 addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams
 addMethodPlaceholders plId state param@AddMinimalMethodsParams{..} = do
     caps <- getClientCapabilities
-    response $ do
+    pluginResponse $ do
         nfp <- getNormalizedFilePath plId uri
         pm <- handleMaybeM "Unable to GetParsedModule"
             $ liftIO
@@ -77,7 +77,7 @@ addMethodPlaceholders plId state param@AddMinimalMethodsParams{..} = do
 -- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is
 -- sensitive to the format of diagnostic messages from GHC.
 codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
-codeAction state plId (CodeActionParams _ _ docId _ context) = response $ do
+codeAction state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do
     nfp <- getNormalizedFilePath plId uri
     actions <- join <$> mapM (mkActions nfp) methodDiags
     pure $ List actions

plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs

@@ -25,7 +25,7 @@ import qualified Language.LSP.Types.Lens         as J
 codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
 codeLens state plId CodeLensParams{..} = do
     enabled <- enableTypeLens <$> getCompletionsConfig plId
-    if not enabled then pure $ pure $ List [] else response $ do
+    if not enabled then pure $ pure $ List [] else pluginResponse $ do
         nfp <- getNormalizedFilePath plId uri
         tmr <- handleMaybeM "Unable to typecheak"
             $ liftIO

plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs

@@ -93,17 +93,20 @@ rules recorder = do
             (_, maybe [] catMaybes -> instanceBinds) <-
                 initTcWithGbl hsc gblEnv ghostSpan $ traverse bindToSig binds
             pure $ Just $ InstanceBindTypeSigsResult instanceBinds
+            where
+                rdrEnv = tcg_rdr_env gblEnv
+                showDoc ty = showSDocForUser' hsc (mkPrintUnqualifiedDefault hsc rdrEnv) (pprSigmaType ty)
+
+                bindToSig id = do
+                    let name = idName id
+                    whenMaybe (isBindingName name) $ do
+                        env <- tcInitTidyEnv
+                        let (_, ty) = tidyOpenType env (idType id)
+                        pure $ InstanceBindTypeSig name
+                                (prettyBindingNameString (printOutputable name) <> " :: " <> T.pack (showDoc ty))
+                                Nothing
         instanceBindType _ _ = pure Nothing
 
-        bindToSig id = do
-            let name = idName id
-            whenMaybe (isBindingName name) $ do
-                env <- tcInitTidyEnv
-                let (_, ty) = tidyOpenType env (idType id)
-                pure $ InstanceBindTypeSig name
-                        (prettyBindingNameString (printOutputable name) <> " :: " <> printOutputable (pprSigmaType ty))
-                        Nothing
-
 properties :: Properties
   '[ 'PropertyKey "typelensOn" 'TBoolean]
 properties = emptyProperties

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

@@ -98,6 +98,7 @@ codeLensTests = testGroup
     , goldenCodeLens "Don't insert pragma while existing" "T13" 0
     , onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $
         goldenCodeLens "Don't insert pragma while GHC2021 enabled" "T14" 0
+    , goldenCodeLens "Qualified name" "T15" 0
     ]
 
 _CACodeAction :: Prism' (Command |? CodeAction) CodeAction

plugins/hls-class-plugin/test/testdata/T15.expected.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE InstanceSigs #-}
+module T15 where
+import qualified T15A
+
+class F a where
+    f :: a
+
+instance F T15A.A where
+  f :: T15A.A
+  f = undefined

plugins/hls-class-plugin/test/testdata/T15.hs

@@ -0,0 +1,8 @@
+module T15 where
+import qualified T15A
+
+class F a where
+    f :: a
+
+instance F T15A.A where
+  f = undefined

plugins/hls-class-plugin/test/testdata/T15A.hs

@@ -0,0 +1,3 @@
+module T15A where
+
+data A

plugins/hls-class-plugin/test/testdata/hie.yaml

@@ -1,3 +1,3 @@
 cradle:
   direct:
-    arguments: [-XHaskell2010]
+    arguments: [-XHaskell2010, T15A]