From f63f18fd1864304bf682989b846b6d899a8c48b7 Mon Sep 17 00:00:00 2001
From: Akshay Mankar <itsakshaymankar@gmail.com>
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 7f68dcbc647..402d9a230c8 100644
--- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
+++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs
@@ -261,13 +261,29 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = liftIO $
             $ pointCommand hf (fromJust (fromCurrentRange pmap range) ^. 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 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 "<haskell-language-sever>") 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