From 351ff510106e11af3373cbd234606774c31e80df Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Fri, 26 Mar 2021 22:11:31 +0800 Subject: [PATCH 1/5] Display package names of external libraries on hover --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 2ae56b2cca..0c61ba3fc6 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -57,7 +57,13 @@ import Data.Either import Data.List (isSuffixOf) import Data.List.Extra (dropEnd1, nubOrd) +import Data.Version (showVersion) import HieDb hiding (pointCommand) +import Packages (InstalledPackageInfo (packageVersion), + PackageName (..), + lookupPackage, + packageNameString, + sourceLibName) -- | Gives a Uri for the module, given the .hie file location and the the module info -- The Bool denotes if it is a boot module @@ -219,11 +225,23 @@ 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 unsafeGlobalDynFlags pid + let pkgName = T.pack $ packageNameString conf + version = T.pack $ showVersion (packageVersion conf) + libName = case sourceLibName conf of + Just (PackageName x) -> ":" <> T.pack (unpackFS x) + _ -> "" + pure $ " *(" <> pkgName <> "-" <> version <> libName <> ")*" + prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of HieFresh -> showGhc t From d8cc357a8a734318159d15bca19b13ca1c3ddbcb Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sun, 28 Mar 2021 16:23:40 +0800 Subject: [PATCH 2/5] Use dynflags of the current file --- ghcide/src/Development/IDE/Core/Rules.hs | 3 ++- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 +++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 1ec74c0018..867da15fc6 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -198,10 +198,11 @@ getAtPoint file pos = runMaybeT $ do opts <- liftIO $ getIdeOptionsIO ide (hf, mapping) <- useE GetHieAst 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 $ fmap (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 0c61ba3fc6..ffe7d933c0 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -202,9 +202,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) @@ -234,7 +235,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) pos = listToMaybe $ point prettyPackageName n = do m <- nameModule_maybe n let pid = moduleUnitId m - conf <- lookupPackage unsafeGlobalDynFlags pid + conf <- lookupPackage df pid let pkgName = T.pack $ packageNameString conf version = T.pack $ showVersion (packageVersion conf) libName = case sourceLibName conf of From 5c338ceb248479e9ee0597f34b9bce064174972a Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Wed, 23 Jun 2021 16:15:35 +0800 Subject: [PATCH 3/5] Add tests --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 +---- ghcide/test/exe/Main.hs | 6 +++--- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 99c47717bd..6ccf00cef2 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -58,10 +58,7 @@ import Data.List.Extra (dropEnd1, nubOrd) import Data.Version (showVersion) import HieDb hiding (pointCommand) -import Packages (InstalledPackageInfo (packageVersion), - PackageName (..), - lookupPackage, - packageNameString, +import Packages (PackageName (..), sourceLibName) import System.Directory (doesFileExist) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 3c0db29088..4be013170e 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3546,17 +3546,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] From b5878b7e70477feae69af231fb3f1cd882cfc71c Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Wed, 23 Jun 2021 19:29:41 +0800 Subject: [PATCH 4/5] Remove unclear lib name --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 6ccf00cef2..85e9fbff57 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -235,10 +235,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) df pos = listToMaybe $ po conf <- lookupPackage df pid let pkgName = T.pack $ packageNameString conf version = T.pack $ showVersion (packageVersion conf) - libName = case sourceLibName conf of - Just (PackageName x) -> ":" <> T.pack (unpackFS x) - _ -> "" - pure $ " *(" <> pkgName <> "-" <> version <> libName <> ")*" + pure $ " *(" <> pkgName <> "-" <> version <> ")*" prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of From 8a50dc7dcb012757b8396a81b92c5ee40b933c81 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Wed, 23 Jun 2021 20:41:02 +0800 Subject: [PATCH 5/5] Cleanup imports --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 85e9fbff57..b87c58e572 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -58,8 +58,6 @@ import Data.List.Extra (dropEnd1, nubOrd) import Data.Version (showVersion) import HieDb hiding (pointCommand) -import Packages (PackageName (..), - sourceLibName) import System.Directory (doesFileExist) -- | Gives a Uri for the module, given the .hie file location and the the module info