Add "Go to type" hyperlinks in the hover popup (like Rust has) #4691
+152
−45
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,24 @@ | ||
| module Development.IDE.Core.LookupMod (lookupMod, LookupModule) where | ||
|
|
||
| import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) | ||
| import Development.IDE.Core.Shake (HieDbWriter, IdeAction) | ||
| import Development.IDE.GHC.Compat.Core (ModuleName, Unit) | ||
| import Development.IDE.Types.Location (Uri) | ||
|
|
||
| -- | 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 | ||
| type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri | ||
|
|
||
| -- | Eventually this will lookup/generate URIs for files in dependencies, but not in the | ||
| -- project. Right now, this is just a stub. | ||
| lookupMod :: | ||
| -- | access the database | ||
| HieDbWriter -> | ||
| -- | The `.hie` file we got from the database | ||
| FilePath -> | ||
| ModuleName -> | ||
| Unit -> | ||
| -- | Is this file a boot file? | ||
| Bool -> | ||
| MaybeT IdeAction Uri | ||
| lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing | ||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -45,7 +45,6 @@ import Development.IDE.GHC.Util (printOutputable) | |
| import Development.IDE.Spans.Common | ||
| import Development.IDE.Types.Options | ||
|
|
||
| import Control.Monad.Extra | ||
| import Control.Monad.IO.Class | ||
| import Control.Monad.Trans.Class | ||
|
|
@@ -61,17 +60,25 @@ import Data.Either | |
| import Data.List.Extra (dropEnd1, nubOrd) | ||
|
|
||
|
|
||
| import Control.Lens ((^.)) | ||
| import Data.Either.Extra (eitherToMaybe) | ||
| import Data.List (isSuffixOf, sortOn) | ||
| import Data.Set (Set) | ||
| import qualified Data.Set as S | ||
| import Data.Tree | ||
| import qualified Data.Tree as T | ||
| import Data.Version (showVersion) | ||
| import Development.IDE.Core.LookupMod (LookupModule, lookupMod) | ||
| import Development.IDE.Core.Shake (ShakeExtras (..), | ||
| runIdeAction) | ||
| import Development.IDE.Types.Shake (WithHieDb) | ||
| import GHC.Iface.Ext.Types (EvVarSource (..), | ||
| HieAST (..), | ||
| HieASTs (..), | ||
| HieArgs (..), | ||
| HieType (..), | ||
| HieTypeFix (..), | ||
| Identifier, | ||
| IdentifierDetails (..), | ||
| NodeInfo (..), Scope, | ||
| Span) | ||
|
|
@@ -86,12 +93,9 @@ import GHC.Iface.Ext.Utils (EvidenceInfo (..), | |
| selectSmallestContaining) | ||
| import HieDb hiding (pointCommand, | ||
| withHieDb) | ||
| import qualified Language.LSP.Protocol.Lens as L | ||
| import System.Directory (doesFileExist) | ||
|
|
||
| -- | HieFileResult for files of interest, along with the position mappings | ||
| newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping)) | ||
|
|
||
|
|
@@ -251,31 +255,41 @@ gotoImplementation withHieDb getHieFile ideOpts srcSpans pos | |
| -- | Synopsis for the name at a given position. | ||
| atPoint | ||
| :: IdeOptions | ||
| -> ShakeExtras | ||
| -> HieAstResult | ||
| -> DocAndTyThingMap | ||
| -> HscEnv | ||
| -> Position | ||
| -> IO (Maybe (Maybe Range, [T.Text])) | ||
| atPoint opts@IdeOptions{} shakeExtras@ShakeExtras{ withHieDb, hiedbWriter } har@(HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos = | ||
| listToMaybe <$> sequence (pointCommand hf pos hoverInfo) | ||
| where | ||
| -- Hover info for values/data | ||
| hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text]) | ||
| hoverInfo ast = do | ||
| locationsWithIdentifier <- runIdeAction "TypeCheck" shakeExtras $ do | ||
| runMaybeT $ gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts har pos | ||
fendor marked this conversation as resolved.
Show resolved
Hide resolved
|
||
|
|
||
| let locationsMap = M.fromList $ mapMaybe (\(loc, identifier) -> case identifier of | ||
| Right typeName -> | ||
| -- Filter out type variables (polymorphic names like 'a', 'b', etc.) | ||
| if isTyVarName typeName | ||
| then Nothing | ||
| else Just (typeName, loc) | ||
| Left _moduleName -> Nothing) $ fromMaybe [] locationsWithIdentifier | ||
|
|
||
| prettyNames <- mapM (prettyName locationsMap) names | ||
| pure (Just range, prettyNames ++ pTypes locationsMap) | ||
| where | ||
| pTypes :: M.Map Name Location -> [T.Text] | ||
| pTypes locationsMap = | ||
| case names of | ||
| [_singleName] -> dropEnd1 $ prettyTypes Nothing locationsMap | ||
| _ -> prettyTypes Nothing locationsMap | ||
|
Comment on lines
-268
to
+288
There was a problem hiding this comment. a bit offtopic:
There was a problem hiding this comment. I'm tempted to remove this (actually I did but then reverted it) because it seems weird and unneeded to me as well. I tested a build without it and it seemed fine. However, this is 4 year old code introduced by 2fef041 so I can't really comment. There was a problem hiding this comment. My guess for the motivation behind I also need to deal with this duplication when implementing signature help. I decide to filter out the same type instead of There was a problem hiding this comment.
There was a problem hiding this comment. @jian-lin your explanation is correct. If we have the expression There was a problem hiding this comment. Thanks @wz1000. However, my main question is that we should always (not just when |
||
|
|
||
| range :: Range | ||
| range = realSrcSpanToRange $ nodeSpan ast | ||
|
|
||
| info :: NodeInfo hietype | ||
| info = nodeInfoH kind ast | ||
|
|
||
|
|
@@ -284,8 +298,8 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D | |
| names :: [(Identifier, IdentifierDetails hietype)] | ||
| names = sortOn (any isEvidenceUse . identInfo . snd) $ M.assocs $ nodeIdentifiers info | ||
|
|
||
| prettyName :: M.Map Name Location -> (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text | ||
| prettyName locationsMap (Right n, dets) | ||
| -- We want to print evidence variable using a readable tree structure. | ||
| -- Evidence variables contain information why a particular instance or | ||
| -- type equality was chosen, paired with location information. | ||
|
|
@@ -299,20 +313,23 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D | |
| pure $ evidenceTree <> "\n" | ||
| -- Identifier details that are not evidence variables are used to display type information and | ||
| -- documentation of that name. | ||
| | otherwise = do | ||
| let | ||
| typeSig = case identType dets of | ||
| Just t -> prettyType (Just n) locationsMap t | ||
| Nothing -> case safeTyThingType =<< lookupNameEnv km n of | ||
| Just kind -> prettyTypeFromType (Just n) locationsMap kind | ||
| Nothing -> wrapHaskell (printOutputable n) | ||
| definitionLoc = maybeToList (pretty (definedAt n) (prettyPackageName n)) | ||
| docs = maybeToList (T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n) | ||
|
|
||
| pure $ T.unlines $ [typeSig] ++ definitionLoc ++ docs | ||
| where | ||
| pretty Nothing Nothing = Nothing | ||
| pretty (Just define) Nothing = Just $ define <> "\n" | ||
| pretty Nothing (Just pkgName) = Just $ pkgName <> "\n" | ||
| pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n" | ||
| prettyName _locationsMap (Left m,_) = packageNameForImportStatement m | ||
|
|
||
| prettyPackageName :: Name -> Maybe T.Text | ||
| prettyPackageName n = do | ||
|
|
@@ -345,11 +362,63 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D | |
| types :: [hietype] | ||
| types = nodeType info | ||
|
|
||
| prettyTypes :: Maybe Name -> M.Map Name Location -> [T.Text] | ||
| prettyTypes boundNameMay locationsMap = | ||
| map (prettyType boundNameMay locationsMap) types | ||
|
|
||
| prettyTypeFromType :: Maybe Name -> M.Map Name Location -> Type -> T.Text | ||
| prettyTypeFromType boundNameMay locationsMap ty = | ||
| prettyTypeCommon boundNameMay locationsMap (S.fromList $ namesInType ty) (printOutputable ty) | ||
|
|
||
| prettyType :: Maybe Name -> M.Map Name Location -> hietype -> T.Text | ||
| prettyType boundNameMay locationsMap t = | ||
| prettyTypeCommon boundNameMay locationsMap (typeNames t) (printOutputable . expandType $ t) | ||
|
|
||
| prettyTypeCommon :: Maybe Name -> M.Map Name Location -> Set Name -> T.Text -> T.Text | ||
| prettyTypeCommon boundNameMay locationsMap names expandedType = | ||
| let nameToUse = case boundNameMay of | ||
| Just n -> printOutputable n | ||
| Nothing -> "_" | ||
| expandedWithName = nameToUse <> " :: " <> expandedType | ||
| codeBlock = wrapHaskell expandedWithName | ||
| links = case boundNameMay of | ||
| Just _ -> generateLinksList locationsMap names | ||
| -- This is so we don't get flooded with links, e.g: | ||
| -- foo :: forall a. MyType a -> a | ||
| -- Go to MyType | ||
| -- _ :: forall a. MyType a -> a | ||
| -- Go to MyType -- <- we don't want this as it's already present | ||
| Nothing -> "" | ||
| in codeBlock <> links | ||
|
|
||
| generateLinksList :: M.Map Name Location -> Set Name -> T.Text | ||
| generateLinksList locationsMap (S.toList -> names) = | ||
| if null generated | ||
| then "" | ||
| else "\n" <> "Go to " <> T.intercalate " | " generated <> "\n" | ||
| where | ||
| generated = mapMaybe generateLink names | ||
|
|
||
| generateLink name = do | ||
| case M.lookup name locationsMap of | ||
| Just (Location uri range) -> | ||
| let nameText = printOutputable name | ||
| link = "[" <> nameText <> "](" <> getUriText uri <> "#L" <> | ||
| T.pack (show (range ^. L.start . L.line + 1)) <> ")" | ||
| in Just link | ||
| Nothing -> Nothing | ||
|
|
||
| wrapHaskell :: T.Text -> T.Text | ||
| wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n" | ||
|
|
||
| getUriText :: Uri -> T.Text | ||
| getUriText (Uri t) = t | ||
|
|
||
| typeNames :: a -> Set Name | ||
| typeNames t = S.fromList $ case kind of | ||
| HieFresh -> namesInType t | ||
| HieFromDisk full_file -> do | ||
| namesInHieTypeFix $ recoverFullType t (hie_types full_file) | ||
|
|
||
| expandType :: a -> SDoc | ||
| expandType t = case kind of | ||
|
|
@@ -468,9 +537,24 @@ namesInType (CastTy t _) = namesInType t | |
| namesInType (LitTy _) = [] | ||
| namesInType _ = [] | ||
|
|
||
|
|
||
| getTypes :: [Type] -> [Name] | ||
| getTypes = concatMap namesInType | ||
|
|
||
| namesInHieTypeFix :: HieTypeFix -> [Name] | ||
| namesInHieTypeFix (Roll hieType) = namesInHieType hieType | ||
|
|
||
| namesInHieType :: HieType HieTypeFix -> [Name] | ||
| namesInHieType (HTyVarTy n) = [n] | ||
| namesInHieType (HAppTy a (HieArgs args)) = namesInHieTypeFix a ++ concatMap (namesInHieTypeFix . snd) args | ||
| namesInHieType (HTyConApp tc (HieArgs args)) = ifaceTyConName tc : concatMap (namesInHieTypeFix . snd) args | ||
| namesInHieType (HForAllTy ((binder, constraint), _) body) = binder : namesInHieTypeFix constraint ++ namesInHieTypeFix body | ||
| namesInHieType (HFunTy mult arg res) = namesInHieTypeFix mult ++ namesInHieTypeFix arg ++ namesInHieTypeFix res | ||
| namesInHieType (HQualTy constraint body) = namesInHieTypeFix constraint ++ namesInHieTypeFix body | ||
| namesInHieType (HLitTy _) = [] | ||
| namesInHieType (HCastTy a) = namesInHieTypeFix a | ||
| namesInHieType HCoercionTy = [] | ||
|
|
||
| -- | Find 'Location's of definition at a specific point and return them along with their 'Identifier's. | ||
| locationsAtPoint | ||
| :: forall m | ||
|
|
||
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Is this still needed?
Uh oh!
There was an error while loading. Please reload this page.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Nope, removed.That was a bit too hasty. This was old code that I had to move around to avoid circular references. It doesn't do anything functionally but maybe the author wants to go back to it at some point.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
In my opinion, and if it is dead code, it should go. We can revive it later if need be.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We want to get back to it eventually, but I also think this is not needed as is and barely gives any advantage right now. So, let's just get rid of it, and then merge :)