Filter generated Core variable names from hovertip documentation (#3316)

* Filter names from hovertip documentation which match patterns of generated Core variables.

* Added comment for isInternal function.

* Relocated list of OccName prefixes from the Completions plugin to the CoreFile module. Updated the check for GHC-generated OccName prefixes in AtPoint to use the shared list of OccName prefixes.

* Added test data and test for ensuring Core-generated variables are not included in hover info.

* Switched to using isEvidenceContext to filter out evidence bindings.

* Relocated list of OccName prefixes from the Completions plugin to the CoreFile module. Updated the check for GHC-generated OccName prefixes in AtPoint to use the shared list of OccName prefixes.

* Removed unused import.

* Relocated list of OccName prefixes from the Completions plugin to the CoreFile module. Updated the check for GHC-generated OccName prefixes in AtPoint to use the shared list of OccName prefixes.

* Removed unused import.

* Fixed incorrect definition of mkRecordSnippetCompItem introduced when rebasing.

* Add preprocessor check for GHC version before using isEvidenceContext. Updated related comment.

Author: drone29a

ghcide/src/Development/IDE/GHC/CoreFile.hs

@@ -10,14 +10,16 @@ module Development.IDE.GHC.CoreFile
   , typecheckCoreFile
   , readBinCoreFile
   , writeBinCoreFile
-  , getImplicitBinds) where
+  , getImplicitBinds
+  , occNamePrefixes) where
 
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Data.Foldable
 import           Data.IORef
 import           Data.List                       (isPrefixOf)
 import           Data.Maybe
+import qualified Data.Text as T
 import           GHC.Fingerprint
 
 import           Development.IDE.GHC.Compat
@@ -228,3 +230,45 @@ tc_iface_bindings (TopIfaceNonRec v e) = do
 tc_iface_bindings (TopIfaceRec vs) = do
   vs' <- traverse (\(v, e) -> (,) <$> pure v <*> tcIfaceExpr e) vs
   pure $ Rec vs'
+
+-- | Prefixes that can occur in a GHC OccName
+occNamePrefixes :: [T.Text]
+occNamePrefixes =
+  [
+    -- long ones
+    "$con2tag_"
+  , "$tag2con_"
+  , "$maxtag_"
+
+  -- four chars
+  , "$sel:"
+  , "$tc'"
+
+  -- three chars
+  , "$dm"
+  , "$co"
+  , "$tc"
+  , "$cp"
+  , "$fx"
+
+  -- two chars
+  , "$W"
+  , "$w"
+  , "$m"
+  , "$b"
+  , "$c"
+  , "$d"
+  , "$i"
+  , "$s"
+  , "$f"
+  , "$r"
+  , "C:"
+  , "N:"
+  , "D:"
+  , "$p"
+  , "$L"
+  , "$f"
+  , "$t"
+  , "$c"
+  , "$m"
+  ]

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -41,6 +41,7 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.GHC.Compat               hiding (ppr)
 import qualified Development.IDE.GHC.Compat               as GHC
 import           Development.IDE.GHC.Compat.Util
+import           Development.IDE.GHC.CoreFile            (occNamePrefixes)
 import           Development.IDE.GHC.Error
 import           Development.IDE.GHC.Util
 import           Development.IDE.Plugin.Completions.Types
@@ -767,50 +768,7 @@ openingBacktick line prefixModule prefixText Position { _character=(fromIntegral
 -- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
 stripPrefix :: T.Text -> T.Text
 stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
-  getFirst $ foldMap (First . (`T.stripPrefix` name)) prefixes
-
--- | Prefixes that can occur in a GHC OccName
-prefixes :: [T.Text]
-prefixes =
-  [
-    -- long ones
-    "$con2tag_"
-  , "$tag2con_"
-  , "$maxtag_"
-
-  -- four chars
-  , "$sel:"
-  , "$tc'"
-
-  -- three chars
-  , "$dm"
-  , "$co"
-  , "$tc"
-  , "$cp"
-  , "$fx"
-
-  -- two chars
-  , "$W"
-  , "$w"
-  , "$m"
-  , "$b"
-  , "$c"
-  , "$d"
-  , "$i"
-  , "$s"
-  , "$f"
-  , "$r"
-  , "C:"
-  , "N:"
-  , "D:"
-  , "$p"
-  , "$L"
-  , "$f"
-  , "$t"
-  , "$c"
-  , "$m"
-  ]
-
+  getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes
 
 mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem
 mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r

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

@@ -227,10 +227,19 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
         wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"
         info = nodeInfoH kind ast
         names = M.assocs $ nodeIdentifiers info
+        -- Check for evidence bindings
+        isInternal :: (Identifier, IdentifierDetails a) -> Bool
+        isInternal (Right _, dets) =
+#if MIN_VERSION_ghc(9,0,1)
+          any isEvidenceContext $ identInfo dets
+#else
+          False
+#endif
+        isInternal (Left _, _) = False
+        filteredNames = filter (not . isInternal) names
         types = nodeType info
-
         prettyNames :: [T.Text]
-        prettyNames = map prettyName names
+        prettyNames = map prettyName filteredNames
         prettyName (Right n, dets) = T.unlines $
           wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
           : maybeToList (pretty (definedAt n) (prettyPackageName n))

ghcide/test/data/hover/GotoHover.hs

@@ -64,3 +64,7 @@ hole = _
 
 hole2 :: a -> Maybe a
 hole2 = _
+
+-- A comment above a type defnition with a deriving clause
+data Example = Example
+  deriving (Eq)

ghcide/test/exe/Main.hs

@@ -1026,6 +1026,7 @@ findDefinitionAndHoverTests = let
             ExpectRange  expectedRange -> checkHoverRange expectedRange rangeInHover msg
             ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg
             ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets
+            ExpectHoverExcludeText snippets -> liftIO $ traverse_ (`assertNotFoundIn` msg) snippets
             ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool)
             ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover
             _ -> pure () -- all other expectations not relevant to hover
@@ -1054,6 +1055,11 @@ findDefinitionAndHoverTests = let
     (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole)
     (part `T.isInfixOf` whole)
 
+  assertNotFoundIn :: T.Text -> T.Text -> Assertion
+  assertNotFoundIn part whole = assertBool
+    (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole)
+    (not . T.isInfixOf part $ whole)
+
   sourceFilePath = T.unpack sourceFileName
   sourceFileName = "GotoHover.hs"
 
@@ -1130,6 +1136,7 @@ findDefinitionAndHoverTests = let
   imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
   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"]]
   in
   mkFindTests
   --      def    hover  look       expect
@@ -1173,6 +1180,7 @@ findDefinitionAndHoverTests = let
   , test  no     broken chrL36     litC          "literal Char in hover info      #1016"
   , test  no     broken txtL8      litT          "literal Text in hover info      #1016"
   , test  no     broken lstL43     litL          "literal List in hover info      #1016"
+  , test  yes    yes    cmtL68     lackOfdEq     "no Core symbols                 #3280"
   , if ghcVersion >= GHC90 then
         test  no     yes    docL41     constr        "type constraint in hover info   #1012"
     else
@@ -2390,6 +2398,7 @@ data Expect
 --  | ExpectDefRange Range -- Only gotoDef should report this range
   | ExpectHoverRange Range -- Only hover should report this range
   | ExpectHoverText [T.Text] -- the hover message must contain these snippets
+  | ExpectHoverExcludeText [T.Text] -- the hover message must _not_ contain these snippets
   | ExpectHoverTextRegex T.Text -- the hover message must match this pattern
   | ExpectExternFail -- definition lookup in other file expected to fail
   | ExpectNoDefinitions