Skip to content

Call hierarchy support #1955

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 33 commits into from
Jul 27, 2021
Merged

Call hierarchy support #1955

Changes from 1 commit
Commits
Show all changes
33 commits
Select commit Hold shift + click to select a range
67ce370
Initialize structure
July541 Jun 3, 2021
4b9a6e7
Add basic tests
July541 Jun 3, 2021
f8cfe98
prepareCallHierarchy
July541 Jun 9, 2021
118acd7
Add prepare call hierarchy tests
July541 Jun 12, 2021
38b5b47
resolve conflicts
July541 Jun 21, 2021
7a8979d
Prepare call hierarchy support
July541 Jun 21, 2021
0058639
Merge branch 'master' of https://github.com/haskell/haskell-language-…
July541 Jul 6, 2021
3c809f0
add outgoing calls
July541 Jul 6, 2021
2b84f2d
Rename incoming to outgoing
July541 Jul 7, 2021
7a41397
Add incoming calls support
July541 Jul 11, 2021
0018dd0
Fix panic error caused by parameters
July541 Jul 12, 2021
04679f1
Prepare callhierarchy tests
July541 Jul 13, 2021
59e2432
Duplication items support
July541 Jul 15, 2021
ad133b7
Format and add missing components for review
July541 Jul 15, 2021
db5bb4d
Use local lsp
July541 Jul 15, 2021
ec420ad
Add CI test
July541 Jul 15, 2021
eec1c98
Fix typo
July541 Jul 15, 2021
047174f
Add flag for 9.0.1
July541 Jul 15, 2021
25927ef
Change lsp repo
July541 Jul 16, 2021
a529246
Fix query error in data declaration
July541 Jul 21, 2021
dcf8aab
Add incoming/outgoing call tests
July541 Jul 21, 2021
68bc9e9
Merge branch 'master' of https://github.com/haskell/haskell-language-…
July541 Jul 21, 2021
649a70f
Add flag for test ghc 9.0.1
July541 Jul 21, 2021
6ca0629
Ignore test on 9.0.1
July541 Jul 21, 2021
b6ead8f
Add 9.0.1 test
July541 Jul 22, 2021
fd11a10
Specifying lsp for cabal
July541 Jul 22, 2021
61d9df9
Merge branch 'master' of https://github.com/haskell/haskell-language-…
July541 Jul 26, 2021
c2bd211
Refresh hiedb before incoming/outgoing calls
July541 Jul 26, 2021
a7fee5f
Add moduleUnit on ghc 9.0.1
July541 Jul 26, 2021
09a8898
Compatible with ghc 9.0.1
July541 Jul 27, 2021
0405d2f
Add missing qualifier
July541 Jul 27, 2021
492c48f
Remove ghcide capability test
July541 Jul 27, 2021
cbbd56e
Merge branch 'master' into call-hierarchy
July541 Jul 27, 2021
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
115 changes: 68 additions & 47 deletions plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Query.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,14 +1,15 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Ide.Plugin.CallHierarchy.Query (
incomingCalls
, outgoingCalls
, getSymbolPosition
) where

import qualified Data.Text as T
import Database.SQLite.Simple
import GHC
import HieDb (HieDb (getConn), Symbol (..),
Expand All @@ -19,55 +20,75 @@ import Name

incomingCalls :: HieDb -> Symbol -> IO [Vertex]
incomingCalls (getConn -> conn) symbol = do
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It would be best to move these functions into hiedb.

let (o, m, u) = parseSymbol symbol
query conn "SELECT mods.mod, defs.occ, mods.hs_src, defs.sl, defs.sc, \
\defs.el, defs.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 = ?) \
\AND \
\(decls.occ != ? OR mods.mod != ? OR mods.unit != ?) \
\AND \
\((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) \
\AND \
\((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))" (o, m, u, o, m, u)
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 "
, "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 = ?) "
, "AND "
, "(decls.occ != ? OR mods.mod != ? OR mods.unit != ?) "
, "AND "
, "((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) "
, "AND "
,"((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))"
]
) (o, m, u, o, m, u)

outgoingCalls :: HieDb -> Symbol -> IO [Vertex]
outgoingCalls (getConn -> conn) symbol = do
let (o, m, u) = parseSymbol symbol
query conn "SELECT rm.mod, defs.occ, rm.hs_src, defs.sl, defs.sc, defs.el, defs.ec, \
\refs.sl, refs.sc, refs.el, refs.ec \
\from refs \
\JOIN defs ON defs.occ = refs.occ \
\JOIN decls rd ON rd.hieFile = defs.hieFile AND rd.occ = defs.occ \
\JOIN mods rm ON rm.mod = refs.mod AND rm.unit = refs.unit AND rm.hieFile = defs.hieFile \
\JOIN decls ON decls.hieFile = refs.hieFile \
\JOIN mods ON mods.hieFile = decls.hieFile \
\where \
\(decls.occ = ? AND mods.mod = ? AND mods.unit = ?) \
\AND \
\(defs.occ != ? OR rm.mod != ? OR rm.unit != ?) \
\AND \
\((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) \
\AND \
\((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))" (o, m, u, o, m, u)
let (o, m, u) = parseSymbol symbol
query conn
(Query $ T.pack $ concat
[ "SELECT rm.mod, defs.occ, rm.hs_src, defs.sl, defs.sc, defs.el, defs.ec, "
, "refs.sl, refs.sc, refs.el, refs.ec "
, "from refs "
, "JOIN defs ON defs.occ = refs.occ "
, "JOIN decls rd ON rd.hieFile = defs.hieFile AND rd.occ = defs.occ "
, "JOIN mods rm ON rm.mod = refs.mod AND rm.unit = refs.unit AND rm.hieFile = defs.hieFile "
, "JOIN decls ON decls.hieFile = refs.hieFile "
, "JOIN mods ON mods.hieFile = decls.hieFile "
, "where "
, "(decls.occ = ? AND mods.mod = ? AND mods.unit = ?) "
, "AND "
, "(defs.occ != ? OR rm.mod != ? OR rm.unit != ?) "
, "AND "
, "((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) "
, "AND "
, "((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))"
]
) (o, m, u, o, m, u)

getSymbolPosition :: HieDb -> Vertex -> IO [SymbolPosition]
getSymbolPosition (getConn -> conn) Vertex{..} = do
query conn "SELECT refs.sl, refs.sc from refs where \
\(occ = ?) \
\AND \
\((refs.sl = ? AND refs.sc > ?) OR (refs.sl > ?)) \
\AND \
\((refs.el = ? AND refs.ec <= ?) OR (refs.el < ?))"
(occ, sl, sc, sl, el, ec, el)
query conn
(Query $ T.pack $ concat
[ "SELECT refs.sl, refs.sc from refs where "
, "(occ = ?) "
, "AND "
, "((refs.sl = ? AND refs.sc > ?) OR (refs.sl > ?)) "
, "AND "
, "((refs.el = ? AND refs.ec <= ?) OR (refs.el < ?))"
]
) (occ, sl, sc, sl, el, ec, el)

#if MIN_VERSION_ghc(9,0,0)
parseSymbol :: Symbol -> (String, String, String)
parseSymbol Symbol{..} =
let o = toNsChar (occNameSpace symName) : occNameString symName
m = moduleNameString $ moduleName symModule
u = unitIdString $ moduleUnitId symModule
in (o, m, u)
let o = toNsChar (occNameSpace symName) : occNameString symName
m = moduleNameString $ moduleName symModule
u = unitString $ moduleUnit symModule
in (o, m, u)
#else
parseSymbol :: Symbol -> (String, String, String)
parseSymbol Symbol{..} =
let o = toNsChar (occNameSpace symName) : occNameString symName
m = moduleNameString $ moduleName symModule
u = unitIdString $ moduleUnitId symModule
in (o, m, u)
#endif