Show package name and its version while hovering on import statements

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

@@ -65,7 +65,7 @@ getAtPoint file pos = runMaybeT $ do
   dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
 
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-  MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap env pos'
+  MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'
 
 -- | For each Loacation, determine if we have the PositionMapping
 -- for the correct file. If not, get the correct position mapping

ghcide/src/Development/IDE/GHC/Compat/Units.hs

@@ -50,63 +50,78 @@ module Development.IDE.GHC.Compat.Units (
     filterInplaceUnits,
     FinderCache,
     showSDocForUser',
+    findImportedModule,
     ) where
 
 import           Control.Monad
-import qualified Data.List.NonEmpty              as NE
-import qualified Data.Map.Strict                 as Map
+import qualified Data.List.NonEmpty                    as NE
+import qualified Data.Map.Strict                       as Map
 #if MIN_VERSION_ghc(9,3,0)
 import           GHC.Unit.Home.ModInfo
 #endif
 #if MIN_VERSION_ghc(9,0,0)
 #if MIN_VERSION_ghc(9,2,0)
-import qualified GHC.Data.ShortText              as ST
+import qualified GHC.Data.ShortText                    as ST
 #if !MIN_VERSION_ghc(9,3,0)
-import           GHC.Driver.Env                  (hsc_unit_dbs)
+import           GHC.Driver.Env                        (hsc_unit_dbs)
 #endif
 import           GHC.Driver.Ppr
 import           GHC.Unit.Env
 import           GHC.Unit.External
-import           GHC.Unit.Finder
+import           GHC.Unit.Finder                       hiding
+                                                       (findImportedModule)
 #else
 import           GHC.Driver.Types
 #endif
 import           GHC.Data.FastString
-import qualified GHC.Driver.Session              as DynFlags
+import qualified GHC.Driver.Session                    as DynFlags
 import           GHC.Types.Unique.Set
-import qualified GHC.Unit.Info                   as UnitInfo
-import           GHC.Unit.State                  (LookupResult, UnitInfo,
-                                                  UnitState (unitInfoMap))
-import qualified GHC.Unit.State                  as State
-import           GHC.Unit.Types                  hiding (moduleUnit, toUnitId)
-import qualified GHC.Unit.Types                  as Unit
+import qualified GHC.Unit.Info                         as UnitInfo
+import           GHC.Unit.State                        (LookupResult, UnitInfo,
+                                                        UnitState (unitInfoMap))
+import qualified GHC.Unit.State                        as State
+import           GHC.Unit.Types                        hiding (moduleUnit,
+                                                        toUnitId)
+import qualified GHC.Unit.Types                        as Unit
 import           GHC.Utils.Outputable
 #else
 import qualified DynFlags
 import           FastString
-import           GhcPlugins                      (SDoc, showSDocForUser)
+import           GhcPlugins                            (SDoc, showSDocForUser)
 import           HscTypes
-import           Module                          hiding (moduleUnitId)
+import           Module                                hiding (moduleUnitId)
 import qualified Module
-import           Packages                        (InstalledPackageInfo (haddockInterfaces, packageName),
-                                                  LookupResult, PackageConfig,
-                                                  PackageConfigMap,
-                                                  PackageState,
-                                                  getPackageConfigMap,
-                                                  lookupPackage')
+import           Packages                              (InstalledPackageInfo (haddockInterfaces, packageName),
+                                                        LookupResult,
+                                                        PackageConfig,
+                                                        PackageConfigMap,
+                                                        PackageState,
+                                                        getPackageConfigMap,
+                                                        lookupPackage')
 import qualified Packages
 #endif
 
 import           Development.IDE.GHC.Compat.Core
 import           Development.IDE.GHC.Compat.Env
 import           Development.IDE.GHC.Compat.Outputable
 #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
-import           Data.Map                        (Map)
+import           Data.Map                              (Map)
 #endif
 import           Data.Either
 import           Data.Version
 import qualified GHC
 
+#if MIN_VERSION_ghc(9,3,0)
+import           GHC.Types.PkgQual                     (PkgQual (NoPkgQual))
+#endif
+#if MIN_VERSION_ghc(9,1,0)
+import qualified GHC.Unit.Finder                       as GHC
+#elif MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Driver.Finder                     as GHC
+#else
+import qualified Finder                                as GHC
+#endif
+
 #if MIN_VERSION_ghc(9,0,0)
 type PreloadUnitClosure = UniqSet UnitId
 #if MIN_VERSION_ghc(9,2,0)
@@ -407,3 +422,14 @@ showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env)
 #else
 showSDocForUser' env = showSDocForUser (hsc_dflags env)
 #endif
+
+findImportedModule :: HscEnv -> ModuleName -> IO (Maybe Module)
+findImportedModule env mn = do
+#if MIN_VERSION_ghc(9,3,0)
+    res <- GHC.findImportedModule env mn NoPkgQual
+#else
+    res <- GHC.findImportedModule env mn Nothing
+#endif
+    case res of
+        Found _ mod -> pure . pure $ mod
+        _           -> pure Nothing

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

@@ -1,9 +1,10 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
-{-# LANGUAGE CPP        #-}
-{-# LANGUAGE GADTs      #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Gives information about symbols at a given point in DAML files.
 -- These are all pure functions that should execute quickly.
@@ -213,21 +214,33 @@ atPoint
   -> DocAndKindMap
   -> HscEnv
   -> Position
-  -> Maybe (Maybe Range, [T.Text])
-atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ pointCommand hf pos hoverInfo
+  -> IO (Maybe (Maybe Range, [T.Text]))
+atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env pos =
+    listToMaybe <$> sequence (pointCommand hf pos hoverInfo)
   where
     -- Hover info for values/data
-    hoverInfo ast = (Just range, prettyNames ++ pTypes)
+    hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text])
+    hoverInfo ast = do
+        prettyNames <- mapM prettyName filteredNames
+        pure (Just range, prettyNames ++ pTypes)
       where
+        pTypes :: [T.Text]
         pTypes
           | Prelude.length names == 1 = dropEnd1 $ map wrapHaskell prettyTypes
           | otherwise = map wrapHaskell prettyTypes
 
+        range :: Range
         range = realSrcSpanToRange $ nodeSpan ast
 
+        wrapHaskell :: T.Text -> T.Text
         wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"
+
+        info :: NodeInfo hietype
         info = nodeInfoH kind ast
+
+        names :: [(Identifier, IdentifierDetails hietype)]
         names = M.assocs $ nodeIdentifiers info
+
         -- Check for evidence bindings
         isInternal :: (Identifier, IdentifierDetails a) -> Bool
         isInternal (Right _, dets) =
@@ -237,11 +250,12 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
           False
 #endif
         isInternal (Left _, _) = False
+
+        filteredNames :: [(Identifier, IdentifierDetails hietype)]
         filteredNames = filter (not . isInternal) names
-        types = nodeType info
-        prettyNames :: [T.Text]
-        prettyNames = map prettyName filteredNames
-        prettyName (Right n, dets) = T.unlines $
+
+        prettyName :: (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text
+        prettyName (Right n, dets) = pure $ T.unlines $
           wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
           : maybeToList (pretty (definedAt n) (prettyPackageName n))
           ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
@@ -251,21 +265,48 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
                 pretty (Just define) Nothing = Just $ define <> "\n"
                 pretty Nothing (Just pkgName) = Just $ pkgName <> "\n"
                 pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n"
-        prettyName (Left m,_) = printOutputable m
+        prettyName (Left m,_) = packageNameForImportStatement m
 
+        prettyPackageName :: Name -> Maybe T.Text
         prettyPackageName n = do
           m <- nameModule_maybe n
+          pkgTxt <- packageNameWithVersion m env
+          pure $ "*(" <> pkgTxt <> ")*"
+
+        -- Return the module text itself and
+        -- the package(with version) this `ModuleName` belongs to.
+        packageNameForImportStatement :: ModuleName -> IO T.Text
+        packageNameForImportStatement mod = do
+          mpkg <- findImportedModule env mod :: IO (Maybe Module)
+          let moduleName = printOutputable mod
+          case mpkg >>= flip packageNameWithVersion env of
+            Nothing             -> pure moduleName
+            Just pkgWithVersion -> pure $ moduleName <> "\n\n" <> pkgWithVersion
+
+        -- Return the package name and version of a module.
+        -- For example, given module `Data.List`, it should return something like `base-4.x`.
+        packageNameWithVersion :: Module -> HscEnv -> Maybe T.Text
+        packageNameWithVersion m env = do
           let pid = moduleUnit m
           conf <- lookupUnit env pid
           let pkgName = T.pack $ unitPackageNameString conf
               version = T.pack $ showVersion (unitPackageVersion conf)
-          pure $ "*(" <> pkgName <> "-" <> version <> ")*"
+          pure $ pkgName <> "-" <> version
+
+        -- Type info for the current node, it may contains several symbols
+        -- for one range, like wildcard
+        types :: [hietype]
+        types = nodeType info
 
+        prettyTypes :: [T.Text]
         prettyTypes = map (("_ :: "<>) . prettyType) types
+
+        prettyType :: hietype -> T.Text
         prettyType t = case kind of
           HieFresh -> printOutputable t
           HieFromDisk full_file -> printOutputable $ hieTypeToIface $ recoverFullType t (hie_types full_file)
 
+        definedAt :: Name -> Maybe T.Text
         definedAt name =
           -- do not show "at <no location info>" and similar messages
           -- see the code of 'pprNameDefnLoc' for more information

ghcide/test/exe/FindDefinitionAndHoverTests.hs

@@ -173,6 +173,7 @@ tests = let
   reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 then 5 else 0) 3 (if ghcVersion >= GHC94 then 8 else 14)]
   thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]
   cmtL68 = Position 67  0  ;  lackOfdEq = [ExpectHoverExcludeText ["$dEq"]]
+  import310 = Position 3 10; pkgTxt = [ExpectHoverText ["Data.Text\n\ntext-"]]
   in
   mkFindTests
   --      def    hover  look       expect
@@ -236,6 +237,7 @@ tests = let
         test  no     broken    thLocL57   thLoc         "TH Splice Hover"
        | otherwise ->
         test  no     yes       thLocL57   thLoc         "TH Splice Hover"
+  , test yes yes import310 pkgTxt "show package name and its version"
   ]
   where yes, broken :: (TestTree -> Maybe TestTree)
         yes    = Just -- test should run and pass

ghcide/test/exe/Main.hs

@@ -124,4 +124,4 @@ main = do
     , GarbageCollectionTests.tests
     , HieDbRetry.tests
     , ExceptionTests.tests recorder logger
-    ]
+    ]