Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 14 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions plugins/hls-class-plugin/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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" "" $
Expand Down
17 changes: 17 additions & 0 deletions plugins/hls-class-plugin/test/testdata/T9.expected.hs
Original file line number Diff line number Diff line change
@@ -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 = _
15 changes: 15 additions & 0 deletions plugins/hls-class-plugin/test/testdata/T9.hs
Original file line number Diff line number Diff line change
@@ -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
Loading