Skip to content

Commit 4ae0fea

Browse files
Display package names of external libraries on hover (#1626)
* Display package names of external libraries on hover * Use dynflags of the current file * Add tests * Remove unclear lib name * Cleanup imports Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 0e642b3 commit 4ae0fea

File tree

3 files changed

+20
-6
lines changed

3 files changed

+20
-6
lines changed

ghcide/src/Development/IDE/Core/Actions.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,10 @@ import Development.IDE.GHC.Compat hiding (TargetFile,
3030
writeHieFile)
3131
import Development.IDE.Graph
3232
import qualified Development.IDE.Spans.AtPoint as AtPoint
33+
import Development.IDE.Types.HscEnvEq (hscEnv)
3334
import Development.IDE.Types.Location
3435
import qualified HieDb
36+
import HscTypes (hsc_dflags)
3537
import Language.LSP.Types (DocumentHighlight (..),
3638
SymbolInformation (..))
3739

@@ -62,10 +64,11 @@ getAtPoint file pos = runMaybeT $ do
6264
opts <- liftIO $ getIdeOptionsIO ide
6365

6466
(hf, mapping) <- useE GetHieAst file
65-
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)
67+
df <- hsc_dflags . hscEnv . fst <$> useE GhcSession file
68+
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useE GetDocMap file)
6669

6770
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
68-
MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos'
71+
MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap df pos'
6972

7073
toCurrentLocations :: PositionMapping -> [Location] -> [Location]
7174
toCurrentLocations mapping = mapMaybe go

ghcide/src/Development/IDE/Spans/AtPoint.hs

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ import Data.Either
5656
import Data.List (isSuffixOf)
5757
import Data.List.Extra (dropEnd1, nubOrd)
5858

59+
import Data.Version (showVersion)
5960
import HieDb hiding (pointCommand)
6061
import System.Directory (doesFileExist)
6162

@@ -196,9 +197,10 @@ atPoint
196197
:: IdeOptions
197198
-> HieAstResult
198199
-> DocAndKindMap
200+
-> DynFlags
199201
-> Position
200202
-> Maybe (Maybe Range, [T.Text])
201-
atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) pos = listToMaybe $ pointCommand hf pos hoverInfo
203+
atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ pointCommand hf pos hoverInfo
202204
where
203205
-- Hover info for values/data
204206
hoverInfo ast = (Just range, prettyNames ++ pTypes)
@@ -219,11 +221,20 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) pos = listToMaybe $ point
219221
prettyName (Right n, dets) = T.unlines $
220222
wrapHaskell (showNameWithoutUniques n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
221223
: definedAt n
224+
++ maybeToList (prettyPackageName n)
222225
++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
223226
]
224227
where maybeKind = fmap showGhc $ safeTyThingType =<< lookupNameEnv km n
225228
prettyName (Left m,_) = showGhc m
226229

230+
prettyPackageName n = do
231+
m <- nameModule_maybe n
232+
let pid = moduleUnitId m
233+
conf <- lookupPackage df pid
234+
let pkgName = T.pack $ packageNameString conf
235+
version = T.pack $ showVersion (packageVersion conf)
236+
pure $ " *(" <> pkgName <> "-" <> version <> ")*"
237+
227238
prettyTypes = map (("_ :: "<>) . prettyType) types
228239
prettyType t = case kind of
229240
HieFresh -> showGhc t

ghcide/test/exe/Main.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3591,17 +3591,17 @@ findDefinitionAndHoverTests = let
35913591
aaaL14 = Position 18 20 ; aaa = [mkR 11 0 11 3]
35923592
dcL7 = Position 11 11 ; tcDC = [mkR 7 23 9 16]
35933593
dcL12 = Position 16 11 ;
3594-
xtcL5 = Position 9 11 ; xtc = [ExpectExternFail, ExpectHoverText ["Int", "Defined in ", "GHC.Types"]]
3594+
xtcL5 = Position 9 11 ; xtc = [ExpectExternFail, ExpectHoverText ["Int", "Defined in ", "GHC.Types", "ghc-prim"]]
35953595
tcL6 = Position 10 11 ; tcData = [mkR 7 0 9 16, ExpectHoverText ["TypeConstructor", "GotoHover.hs:8:1"]]
35963596
vvL16 = Position 20 12 ; vv = [mkR 20 4 20 6]
35973597
opL16 = Position 20 15 ; op = [mkR 21 2 21 4]
35983598
opL18 = Position 22 22 ; opp = [mkR 22 13 22 17]
35993599
aL18 = Position 22 20 ; apmp = [mkR 22 10 22 11]
36003600
b'L19 = Position 23 13 ; bp = [mkR 23 6 23 7]
3601-
xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text"]]
3601+
xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text", "text"]]
36023602
clL23 = Position 27 11 ; cls = [mkR 25 0 26 20, ExpectHoverText ["MyClass", "GotoHover.hs:26:1"]]
36033603
clL25 = Position 29 9
3604-
eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", "GHC.Num"]]
3604+
eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", "GHC.Num", "base"]]
36053605
dnbL29 = Position 33 18 ; dnb = [ExpectHoverText [":: ()"], mkR 33 12 33 21]
36063606
dnbL30 = Position 34 23
36073607
lcbL33 = Position 37 26 ; lcb = [ExpectHoverText [":: Char"], mkR 37 26 37 27]

0 commit comments

Comments
 (0)