Skip to content

Commit

Permalink
Correct instance for incoming
Browse files Browse the repository at this point in the history
  • Loading branch information
July541 committed Sep 6, 2021
1 parent 2358362 commit fa147ab
Show file tree
Hide file tree
Showing 2 changed files with 13 additions and 4 deletions.
Expand Up @@ -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 = ?) "
Expand Down
12 changes: 11 additions & 1 deletion plugins/hls-call-hierarchy-plugin/test/Main.hs
Expand Up @@ -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
Expand Down

0 comments on commit fa147ab

Please sign in to comment.