From f4393e6fbdd9214ee174b361898b956d6bba911b Mon Sep 17 00:00:00 2001 From: DeviousStoat Date: Mon, 15 Jan 2024 19:50:02 +0100 Subject: [PATCH 1/4] Display instances on hover for type and data constructors --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 25 +++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 8e1508cdd2..64b12afeb4 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -35,7 +35,8 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util -import Development.IDE.GHC.Util (printOutputable) +import Development.IDE.GHC.Util (evalGhcEnv, + printOutputable) import Development.IDE.Spans.Common import Development.IDE.Types.Options @@ -57,6 +58,7 @@ import Data.List.Extra (dropEnd1, nubOrd) import Data.Version (showVersion) import Development.IDE.Types.Shake (WithHieDb) +import GHC (getInstancesForType) import HieDb hiding (pointCommand, withHieDb) import System.Directory (doesFileExist) @@ -218,7 +220,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text]) hoverInfo ast = do prettyNames <- mapM prettyName filteredNames - pure (Just range, prettyNames ++ pTypes) + instances <- catMaybes <$> mapM prettyInstances filteredNames + pure (Just range, prettyNames ++ pTypes ++ instances) where pTypes :: [T.Text] pTypes @@ -306,6 +309,24 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*" + prettyInstances :: (Either ModuleName Name, IdentifierDetails hietype) -> IO (Maybe T.Text) + prettyInstances (Right n, _) = + fmap (wrapHaskell . T.unlines . fmap printOutputable) <$> instancesForName + where + instancesForName :: IO (Maybe [ClsInst]) + instancesForName = runMaybeT $ do + typ <- MaybeT . pure $ lookupNameEnv km n >>= tyThingToType + liftIO $ evalGhcEnv env $ getInstancesForType typ + + tyThingToType :: TyThing -> Maybe Type + tyThingToType (AnId _) = Nothing + tyThingToType (ACoAxiom _) = Nothing + tyThingToType (AConLike cl) = case cl of + PatSynCon _ -> Nothing + RealDataCon dc -> Just $ mkTyConTy $ dataConTyCon dc + tyThingToType (ATyCon tc) = Just $ mkTyConTy tc + prettyInstances (Left _, _) = pure Nothing + typeLocationsAtPoint :: forall m . MonadIO m From a67792e5b969cd6fbb7c74cde26c70131dd19f9c Mon Sep 17 00:00:00 2001 From: DeviousStoat Date: Fri, 19 Jan 2024 05:58:12 +0100 Subject: [PATCH 2/4] Rename tyThingToType --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 64b12afeb4..9c3b7e6323 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -315,16 +315,18 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env where instancesForName :: IO (Maybe [ClsInst]) instancesForName = runMaybeT $ do - typ <- MaybeT . pure $ lookupNameEnv km n >>= tyThingToType + typ <- MaybeT . pure $ lookupNameEnv km n >>= tyThingAsDataType liftIO $ evalGhcEnv env $ getInstancesForType typ - tyThingToType :: TyThing -> Maybe Type - tyThingToType (AnId _) = Nothing - tyThingToType (ACoAxiom _) = Nothing - tyThingToType (AConLike cl) = case cl of + -- | Gets the datatype `Type` corresponding to a TyThing, if it repressents a datatype or + -- a data constructor. + tyThingAsDataType :: TyThing -> Maybe Type + tyThingAsDataType (AnId _) = Nothing + tyThingAsDataType (ACoAxiom _) = Nothing + tyThingAsDataType (AConLike cl) = case cl of PatSynCon _ -> Nothing RealDataCon dc -> Just $ mkTyConTy $ dataConTyCon dc - tyThingToType (ATyCon tc) = Just $ mkTyConTy tc + tyThingAsDataType (ATyCon tc) = Just $ mkTyConTy tc prettyInstances (Left _, _) = pure Nothing typeLocationsAtPoint From cdefac2a7e8f25bfdeaa43c7486200eccbb55696 Mon Sep 17 00:00:00 2001 From: DeviousStoat Date: Fri, 19 Jan 2024 06:07:30 +0100 Subject: [PATCH 3/4] prettyInstances takes Name argument --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 9c3b7e6323..4922e204e0 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -220,7 +220,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text]) hoverInfo ast = do prettyNames <- mapM prettyName filteredNames - instances <- catMaybes <$> mapM prettyInstances filteredNames + instances <- catMaybes <$> mapM (either (const $ pure Nothing) prettyInstances . fst) filteredNames pure (Just range, prettyNames ++ pTypes ++ instances) where pTypes :: [T.Text] @@ -309,8 +309,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*" - prettyInstances :: (Either ModuleName Name, IdentifierDetails hietype) -> IO (Maybe T.Text) - prettyInstances (Right n, _) = + prettyInstances :: Name -> IO (Maybe T.Text) + prettyInstances n = fmap (wrapHaskell . T.unlines . fmap printOutputable) <$> instancesForName where instancesForName :: IO (Maybe [ClsInst]) @@ -327,7 +327,6 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env PatSynCon _ -> Nothing RealDataCon dc -> Just $ mkTyConTy $ dataConTyCon dc tyThingAsDataType (ATyCon tc) = Just $ mkTyConTy tc - prettyInstances (Left _, _) = pure Nothing typeLocationsAtPoint :: forall m From cf69ce5587ee693e89c938a8c3406ce7ef6b3a5a Mon Sep 17 00:00:00 2001 From: DeviousStoat Date: Fri, 19 Jan 2024 08:32:03 +0100 Subject: [PATCH 4/4] Avoid creating an empty section if no instances are found --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 4922e204e0..86063c104f 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -316,7 +316,10 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env instancesForName :: IO (Maybe [ClsInst]) instancesForName = runMaybeT $ do typ <- MaybeT . pure $ lookupNameEnv km n >>= tyThingAsDataType - liftIO $ evalGhcEnv env $ getInstancesForType typ + clsInst <- liftIO $ evalGhcEnv env $ getInstancesForType typ + -- Avoid creating an empty wrapped section if no instances are found + guard $ not $ null clsInst + return clsInst -- | Gets the datatype `Type` corresponding to a TyThing, if it repressents a datatype or -- a data constructor.