Merge master

Author: July541

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

@@ -202,7 +202,7 @@ minDefToMethodGroups range sigs = go
     where
         go (Var mn)   = [[ (T.pack . occNameString . occName $ mn, bindRendered sig)
                         | sig <- sigs
-                        , inRange range (getSrcSpan (bindName sig))
+                        , inRange range (getSrcSpan $ bindName sig)
                         , printOutputable mn == T.drop (T.length bindingPrefix) (printOutputable (bindName sig))
                         ]]
         go (Or ms)    = concatMap (go . unLoc) ms

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

@@ -86,8 +86,8 @@ codeLens state plId CodeLensParams{..} = do
                 -- Existed signatures' name
                 sigNames = concat $ mapMaybe (\(L _ r) -> getSigName r) cid_sigs
                 toBindInfo (L l (L l' _)) = BindInfo
-                    (getLoc l) -- bindSpan
-                    (getLoc l') -- bindNameSpan
+                    (locA l) -- bindSpan
+                    (locA l') -- bindNameSpan
             in toBindInfo <$> filter (\(L _ name) -> unLoc name `notElem` sigNames) bindNames
         getBindSpanWithoutSig _ = []
 

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

@@ -118,5 +118,5 @@ addMethodDecls ps mDecls range withSig = do
     foldM (insertAfter d) ps (reverse decls)
 
 findInstDecl :: ParsedSource -> Range -> Transform (LHsDecl GhcPs)
-findInstDecl ps range = head . filter (inRange range) <$> hsDecls ps
+findInstDecl ps range = head . filter (inRange range . getLoc) <$> hsDecls ps
 #endif

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

@@ -99,17 +99,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/src/Ide/Plugin/Class/Utils.hs

@@ -25,8 +25,8 @@ isBindingName :: Name -> Bool
 isBindingName name = isPrefixOf bindingPrefix $ occNameString $ nameOccName name
 
 -- | Check if some `HasSrcSpan` value in the given range
-inRange :: HasSrcSpan a => Range -> a -> Bool
-inRange range s = maybe False (subRange range) (srcSpanToRange (getLoc s))
+inRange :: Range -> SrcSpan -> Bool
+inRange range s = maybe False (subRange range) (srcSpanToRange s)
 
 ghostSpan :: RealSrcSpan
 ghostSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<haskell-language-sever>") 1 1

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

@@ -70,7 +70,7 @@ codeActionTests recorder = testGroup
   , goldenWithClass recorder "Creates a placeholder for other two methods" "T6" "2" $ \(_:_:ghAction:_) -> do
       executeCodeAction ghAction
   , onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $
-      goldenWithClass recorder "Don't insert pragma with GHC2021" "T15" "" $ \(_:eqWithSig:_) -> do
+      goldenWithClass recorder "Don't insert pragma with GHC2021" "T16" "" $ \(_:eqWithSig:_) -> do
         executeCodeAction eqWithSig
   , goldenWithClass recorder "Insert pragma if not exist" "T7" "" $ \(_:eqWithSig:_) -> do
       executeCodeAction eqWithSig
@@ -107,6 +107,7 @@ codeLensTests recorder = testGroup
     , goldenCodeLens recorder "Don't insert pragma while existing" "T13" 0
     , onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $
         goldenCodeLens recorder "Don't insert pragma while GHC2021 enabled" "T14" 0
+    , goldenCodeLens recorder "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

@@ -1,5 +1,8 @@
-{-# LANGUAGE GHC2021#-}
 module T15 where
+import qualified T15A
 
-data A
-instance Eq A
+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/T16.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE GHC2021#-}
+module T16 where
+
+data A
+instance Eq A

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

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