Exclude superclass-generated names in class placeholders (#4902)

* Exclude superclass-generated names in class placeholders

Superclasses generate bindings in typeclasses as well. When determining
which bindings to create placeholders for, these superclass-generated
names need to be excluded.

At the time of writing, this corresponds to the `mkSuperDictAuxOcc`
function in Occurrence.hs in GHC, see the subsection on `Making system
names` for the relevant bit.

* Reference GHC issue in superclass binder check

Author: crtschin

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

@@ -4,7 +4,7 @@ module Ide.Plugin.Class.Utils where
 
 import           Control.Monad.IO.Class           (MonadIO, liftIO)
 import           Control.Monad.Trans.Except
-import           Data.Char                        (isAlpha)
+import           Data.Char                        (isAlpha, isDigit)
 import           Data.List                        (isPrefixOf)
 import           Data.String                      (IsString)
 import qualified Data.Text                        as T
@@ -22,8 +22,20 @@ import           Language.LSP.Protocol.Types
 bindingPrefix :: IsString s => s
 bindingPrefix = "$c"
 
+-- | Superclasses generate bindings in typeclasses as well.
+--
+-- When determining which bindings to create placeholders for, these
+-- superclass-generated names need to be excluded.
+-- TODO: This function should be replaced by an equivalent one from GHC:
+--   https://gitlab.haskell.org/ghc/ghc/-/issues/27195
+isSuperClassesBindingPrefix :: String -> Bool
+isSuperClassesBindingPrefix ('$' : 'c' : 'p' : n : _) | isDigit n = True
+isSuperClassesBindingPrefix _ = False
+
 isBindingName :: Name -> Bool
-isBindingName name = isPrefixOf bindingPrefix $ occNameString $ nameOccName name
+isBindingName name =
+  let bindingName = occNameString $ nameOccName name
+   in isPrefixOf bindingPrefix bindingName && not (isSuperClassesBindingPrefix bindingName)
 
 -- | Check if some `HasSrcSpan` value in the given range
 inRange :: Range -> SrcSpan -> Bool

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

@@ -72,6 +72,8 @@ codeActionTests = testGroup
         goldenWithClass "Creates a placeholder for '<>'" "T8" "diamond" $
       getActionByTitle "Add placeholders for '<>'"
       ]
+  , goldenWithClass "Creates a placeholder for type classes with super classes" "T9" "" $
+      getActionByTitle "Add placeholders for all missing methods"
   , goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $
       getActionByTitle "Add placeholders for '==' with signature(s)"
   , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $

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

@@ -0,0 +1,17 @@
+module T9 where
+
+class A a where
+  a :: a
+
+instance A Int where
+  a = 1
+
+class (A a) => B a where
+  {-# MINIMAL b1 #-}
+  b1 :: a
+  b2 :: a
+  b2 = b1
+
+instance B Int where
+  b1 = _
+  b2 = _

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

@@ -0,0 +1,15 @@
+module T9 where
+
+class A a where
+  a :: a
+
+instance A Int where
+  a = 1
+
+class (A a) => B a where
+  {-# MINIMAL b1 #-}
+  b1 :: a
+  b2 :: a
+  b2 = b1
+
+instance B Int where