Correct instance for incoming

Author: July541

plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs

@@ -21,11 +21,10 @@ incomingCalls (getConn -> conn) symbol = do
     let (o, m, u) = parseSymbol symbol
     query conn
         (Query $ T.pack $ concat
-            [ "SELECT mods.mod, defs.occ, mods.hs_src, defs.sl, defs.sc, "
-            , "defs.el, defs.ec, refs.sl, refs.sc, refs.el, refs.ec "
+            [ "SELECT mods.mod, decls.occ, mods.hs_src, decls.sl, decls.sc, "
+            , "decls.el, decls.ec, refs.sl, refs.sc, refs.el, refs.ec "
             , "FROM refs "
             , "JOIN decls ON decls.hieFile = refs.hieFile "
-            , "JOIN defs ON defs.hieFile = decls.hieFile AND defs.occ = decls.occ "
             , "JOIN mods ON mods.hieFile = decls.hieFile "
             , "where "
             , "(refs.occ = ? AND refs.mod = ? AND refs.unit = ?) "

plugins/hls-call-hierarchy-plugin/test/Main.hs

@@ -254,14 +254,24 @@ incomingCallsTests =
               positions = [(0, 6)]
               ranges = [mkRange 0 16 0 17]
           incomingCallTestCase contents 1 20 positions ranges
+      , testCase "goto typeclass instance" $ do
+          let contents = T.unlines
+                [ "class F a where f :: a"
+                , "instance F Bool where f = x"
+                , "instance F Int where f = 3"
+                , "x = True"
+                ]
+              positions = [(1, 22)]
+              ranges = [mkRange 1 26 1 27]
+          incomingCallTestCase contents 3 0 positions ranges
       ]
     , testCase "type family instance" $ do
         let contents = T.unlines
               [ "{-# LANGUAGE TypeFamilies #-}"
               , "type family A a"
               , "type instance A Int = Char"
               ]
-            positions = [(1, 12)]
+            positions = [(2, 14)]
             ranges = [mkRange 2 22 2 26]
         incomingCallTestCase contents 2 22 positions ranges
     , testCase "GADT" $ do