diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 737441f9ef..00a778afda 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -10,7 +10,8 @@ module Development.IDE.GHC.CoreFile , typecheckCoreFile , readBinCoreFile , writeBinCoreFile - , getImplicitBinds) where + , getImplicitBinds + , occNamePrefixes) where import Control.Monad import Control.Monad.IO.Class @@ -18,6 +19,7 @@ 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" + ] diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 92a4ea0320..362fb68993 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index cd55fbb979..fafb18af0e 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/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)) diff --git a/ghcide/test/data/hover/GotoHover.hs b/ghcide/test/data/hover/GotoHover.hs index e1802580e2..6ff3eeffed 100644 --- a/ghcide/test/data/hover/GotoHover.hs +++ b/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) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 32b52f31e8..3034c8d597 100644 --- a/ghcide/test/exe/Main.hs +++ b/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