Display instances on hover for type and data constructors

Author: DeviousStoat

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

@@ -37,7 +37,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
 
@@ -59,6 +60,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)
@@ -220,7 +222,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
@@ -308,6 +311,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