From da0d38879038ae511d4ac3b1d7ad053b06a5baa8 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Fri, 17 Jun 2022 09:21:20 +0200 Subject: [PATCH] hls-class-plugin: Find methods even inside an EvidenceVarBind --- .../hls-class-plugin/src/Ide/Plugin/Class.hs | 20 +++++++++++++++++-- .../test/testdata/T6.1.expected.hs | 5 ++++- .../test/testdata/T6.2.expected.hs | 5 ++++- plugins/hls-class-plugin/test/testdata/T6.hs | 5 ++++- 4 files changed, 30 insertions(+), 5 deletions(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index b49e9c8f709..c5d0c93ea9c 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -262,13 +262,29 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = liftIO $ $ pointCommand hf (instanceRange ^. J.start & J.character -~ 1) $ map (T.pack . getOccString) . rights . findInstanceValBindIdentifiers + -- | Recurses through the given AST to find identifiers which are are + -- 'InstanceValBind's. Two types of nodes are chosen to look inside: + -- + -- 1. The nodes which don't have any identifiers: these are the nodes which + -- somehow wrap an expression, like the instance declaration itself, or a + -- 'Match' which contains the 'InstanceValBind'. + -- + -- 2. The nodes which have an 'EvidenceVarBind': if one of the implemented + -- methods uses functions like 'undefined', the binding for the '?callstack' + -- gets bound over the 'Match' which contains the 'InstanceValBind', so to + -- find the 'InstanceValBind' this function must look inside any + -- 'EvidenceVarBind's it finds. findInstanceValBindIdentifiers :: HieAST a -> [Identifier] findInstanceValBindIdentifiers ast - | Map.null (getNodeIds ast) = concatMap findInstanceValBindIdentifiers (nodeChildren ast) + | Map.null nodeIds + || hasEvidenceBind nodeIds = concatMap findInstanceValBindIdentifiers (nodeChildren ast) | otherwise = Map.keys . Map.filter (not . Set.null) . Map.map (Set.filter isInstanceValBind . identInfo) - $ getNodeIds ast + $ nodeIds + where + nodeIds = getNodeIds ast + hasEvidenceBind = not . Map.null . Map.filter (any isEvidenceBind . identInfo) ghostSpan :: RealSrcSpan ghostSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "") 1 1 diff --git a/plugins/hls-class-plugin/test/testdata/T6.1.expected.hs b/plugins/hls-class-plugin/test/testdata/T6.1.expected.hs index 492264e8d03..a1e64f591b3 100644 --- a/plugins/hls-class-plugin/test/testdata/T6.1.expected.hs +++ b/plugins/hls-class-plugin/test/testdata/T6.1.expected.hs @@ -11,9 +11,12 @@ class Test a where h :: a -> a h = f - {-# MINIMAL f, g | g, h #-} + i :: a + + {-# MINIMAL f, g, i | g, h #-} instance Test X where f X = X f Y = Y + i = undefined g = _ diff --git a/plugins/hls-class-plugin/test/testdata/T6.2.expected.hs b/plugins/hls-class-plugin/test/testdata/T6.2.expected.hs index 8245f07dfa8..2b7b5454b98 100644 --- a/plugins/hls-class-plugin/test/testdata/T6.2.expected.hs +++ b/plugins/hls-class-plugin/test/testdata/T6.2.expected.hs @@ -11,10 +11,13 @@ class Test a where h :: a -> a h = f - {-# MINIMAL f, g | g, h #-} + i :: a + + {-# MINIMAL f, g, i | g, h #-} instance Test X where f X = X f Y = Y + i = undefined g = _ h = _ diff --git a/plugins/hls-class-plugin/test/testdata/T6.hs b/plugins/hls-class-plugin/test/testdata/T6.hs index 47e10261091..61d2c6dc622 100644 --- a/plugins/hls-class-plugin/test/testdata/T6.hs +++ b/plugins/hls-class-plugin/test/testdata/T6.hs @@ -11,8 +11,11 @@ class Test a where h :: a -> a h = f - {-# MINIMAL f, g | g, h #-} + i :: a + + {-# MINIMAL f, g, i | g, h #-} instance Test X where f X = X f Y = Y + i = undefined