diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 0ad8b86e9c..c729ec8e5d 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -32,9 +32,9 @@ 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.Spans.Common import Development.IDE.Types.Options -import Development.IDE.GHC.Util (printOutputable) import Control.Applicative import Control.Monad.Extra @@ -231,11 +231,14 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p prettyNames = map prettyName names prettyName (Right n, dets) = T.unlines $ wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) - : definedAt n - ++ maybeToList (prettyPackageName n) + : maybeToList (pretty (definedAt n) (prettyPackageName n)) ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n ] where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n + 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 (Left m,_) = printOutputable m prettyPackageName n = do @@ -244,7 +247,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p conf <- lookupUnit env pid let pkgName = T.pack $ unitPackageNameString conf version = T.pack $ showVersion (unitPackageVersion conf) - pure $ " *(" <> pkgName <> "-" <> version <> ")*" + pure $ "*(" <> pkgName <> "-" <> version <> ")*" prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of @@ -255,8 +258,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p -- do not show "at " and similar messages -- see the code of 'pprNameDefnLoc' for more information case nameSrcLoc name of - UnhelpfulLoc {} | isInternalName name || isSystemName name -> [] - _ -> ["*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"] + UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing + _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*" typeLocationsAtPoint :: forall m diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 7da8c70cd9..dd241e7fc9 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -51,9 +51,7 @@ safeTyThingId _ = Nothing -- Possible documentation for an element in the code data SpanDoc = SpanDocString HsDocString SpanDocUris - -- ^ Extern module doc | SpanDocText [T.Text] SpanDocUris - -- ^ Local module doc deriving stock (Eq, Show, Generic) deriving anyclass NFData @@ -80,6 +78,11 @@ emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing) -- it will result "xxxx---\nyyyy" and can't be rendered as a normal doc. -- Therefore we check every item in the value to make sure they all end with '\\n', -- this makes "xxxx\n---\nyyy\n" and can be rendered correctly. +-- +-- Notes: +-- +-- To insert a new line in Markdown, we need two '\\n', like ("\\n\\n"), __or__ a section +-- symbol with one '\\n', like ("***\\n"). spanDocToMarkdown :: SpanDoc -> [T.Text] spanDocToMarkdown = \case (SpanDocString docs uris) -> diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index d66fc30ca8..f13c4e183c 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4254,6 +4254,7 @@ findDefinitionAndHoverTests = let ExpectRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` 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 _ -> liftIO $ assertFailure $ "test not expecting this kind of hover info" <> show hover @@ -4344,7 +4345,7 @@ findDefinitionAndHoverTests = let innL48 = Position 52 5 ; innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7] holeL60 = Position 62 7 ; hleInfo = [ExpectHoverText ["_ ::"]] holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] - cccL17 = Position 17 16 ; docLink = [ExpectHoverText ["[Documentation](file:///"]] + cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] 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 0 3 14] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]] @@ -4399,7 +4400,7 @@ findDefinitionAndHoverTests = let , test broken broken innL48 innSig "inner signature #767" , test no yes holeL60 hleInfo "hole without internal name #831" , test no yes holeL65 hleInfo2 "hole with variable" - , test no skip cccL17 docLink "Haddock html links" + , test no yes cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" , if | ghcVersion == GHC90 && isWindows -> @@ -5743,6 +5744,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 + | ExpectHoverTextRegex T.Text -- the hover message must match this pattern | ExpectExternFail -- definition lookup in other file expected to fail | ExpectNoDefinitions | ExpectNoHover