diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index e653a02728..c776ff7908 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -30,8 +30,10 @@ import Development.IDE.GHC.Compat hiding (TargetFile, writeHieFile) import Development.IDE.Graph import qualified Development.IDE.Spans.AtPoint as AtPoint +import Development.IDE.Types.HscEnvEq (hscEnv) import Development.IDE.Types.Location import qualified HieDb +import HscTypes (hsc_dflags) import Language.LSP.Types (DocumentHighlight (..), SymbolInformation (..)) @@ -62,10 +64,11 @@ getAtPoint file pos = runMaybeT $ do opts <- liftIO $ getIdeOptionsIO ide (hf, mapping) <- useE GetHieAst file - dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file) + df <- hsc_dflags . hscEnv . fst <$> useE GhcSession file + dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useE GetDocMap file) !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) - MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos' + MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap df pos' toCurrentLocations :: PositionMapping -> [Location] -> [Location] toCurrentLocations mapping = mapMaybe go diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 3cbec0f363..b87c58e572 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -56,6 +56,7 @@ import Data.Either import Data.List (isSuffixOf) import Data.List.Extra (dropEnd1, nubOrd) +import Data.Version (showVersion) import HieDb hiding (pointCommand) import System.Directory (doesFileExist) @@ -196,9 +197,10 @@ atPoint :: IdeOptions -> HieAstResult -> DocAndKindMap + -> DynFlags -> Position -> Maybe (Maybe Range, [T.Text]) -atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) pos = listToMaybe $ pointCommand hf pos hoverInfo +atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ pointCommand hf pos hoverInfo where -- Hover info for values/data hoverInfo ast = (Just range, prettyNames ++ pTypes) @@ -219,11 +221,20 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) pos = listToMaybe $ point prettyName (Right n, dets) = T.unlines $ wrapHaskell (showNameWithoutUniques n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) : definedAt n + ++ maybeToList (prettyPackageName n) ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n ] where maybeKind = fmap showGhc $ safeTyThingType =<< lookupNameEnv km n prettyName (Left m,_) = showGhc m + prettyPackageName n = do + m <- nameModule_maybe n + let pid = moduleUnitId m + conf <- lookupPackage df pid + let pkgName = T.pack $ packageNameString conf + version = T.pack $ showVersion (packageVersion conf) + pure $ " *(" <> pkgName <> "-" <> version <> ")*" + prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of HieFresh -> showGhc t diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index d04d6b9e30..9f67fcdcb7 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3591,17 +3591,17 @@ findDefinitionAndHoverTests = let aaaL14 = Position 18 20 ; aaa = [mkR 11 0 11 3] dcL7 = Position 11 11 ; tcDC = [mkR 7 23 9 16] dcL12 = Position 16 11 ; - xtcL5 = Position 9 11 ; xtc = [ExpectExternFail, ExpectHoverText ["Int", "Defined in ", "GHC.Types"]] + xtcL5 = Position 9 11 ; xtc = [ExpectExternFail, ExpectHoverText ["Int", "Defined in ", "GHC.Types", "ghc-prim"]] tcL6 = Position 10 11 ; tcData = [mkR 7 0 9 16, ExpectHoverText ["TypeConstructor", "GotoHover.hs:8:1"]] vvL16 = Position 20 12 ; vv = [mkR 20 4 20 6] opL16 = Position 20 15 ; op = [mkR 21 2 21 4] opL18 = Position 22 22 ; opp = [mkR 22 13 22 17] aL18 = Position 22 20 ; apmp = [mkR 22 10 22 11] b'L19 = Position 23 13 ; bp = [mkR 23 6 23 7] - xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text"]] + xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text", "text"]] clL23 = Position 27 11 ; cls = [mkR 25 0 26 20, ExpectHoverText ["MyClass", "GotoHover.hs:26:1"]] clL25 = Position 29 9 - eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", "GHC.Num"]] + eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", "GHC.Num", "base"]] dnbL29 = Position 33 18 ; dnb = [ExpectHoverText [":: ()"], mkR 33 12 33 21] dnbL30 = Position 34 23 lcbL33 = Position 37 26 ; lcb = [ExpectHoverText [":: Char"], mkR 37 26 37 27]