From b384b80652c290c8980f0d8ac55d996765c63884 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sun, 19 Apr 2026 01:50:04 +0200 Subject: [PATCH 1/2] 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. --- .../src/Ide/Plugin/Class/Utils.hs | 16 ++++++++++++++-- plugins/hls-class-plugin/test/Main.hs | 2 ++ .../test/testdata/T9.expected.hs | 17 +++++++++++++++++ plugins/hls-class-plugin/test/testdata/T9.hs | 15 +++++++++++++++ 4 files changed, 48 insertions(+), 2 deletions(-) create mode 100644 plugins/hls-class-plugin/test/testdata/T9.expected.hs create mode 100644 plugins/hls-class-plugin/test/testdata/T9.hs diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs index e73344c341..381fa8d396 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/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. +-- +-- 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. When determining which bindings to create placeholders for, +-- these superclass-generated names need to be excluded. +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 diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index ac1d743409..566ba6e154 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/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" "" $ diff --git a/plugins/hls-class-plugin/test/testdata/T9.expected.hs b/plugins/hls-class-plugin/test/testdata/T9.expected.hs new file mode 100644 index 0000000000..1fa679a1ce --- /dev/null +++ b/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 = _ diff --git a/plugins/hls-class-plugin/test/testdata/T9.hs b/plugins/hls-class-plugin/test/testdata/T9.hs new file mode 100644 index 0000000000..27bd926c00 --- /dev/null +++ b/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 From 77c63d3e6fde5d0d5dd5ca093f8c55cfc7674d41 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sun, 19 Apr 2026 11:30:14 +0200 Subject: [PATCH 2/2] Reference GHC issue in superclass binder check --- plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs index 381fa8d396..ae4579d115 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs @@ -24,10 +24,10 @@ bindingPrefix = "$c" -- | Superclasses generate bindings in typeclasses as well. -- --- 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. When determining which bindings to create placeholders for, --- these superclass-generated names need to be excluded. +-- 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