Skip to content

Fix hover format #2911

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
May 24, 2022
Merged

Fix hover format #2911

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
72d883a
Fix hover format
July541 May 17, 2022
55eaebc
Test with regex
July541 May 18, 2022
d2b7642
Add comments about inserting a new line in Markdown
July541 May 23, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 9 additions & 6 deletions ghcide/src/Development/IDE/Spans/AtPoint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Completely independent of this PR, but I wonder if we'd make our lives easier by using prettyprinter for some of this stuff 🤔

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Unfortunately, I have little knowledge about prettyprinter... Maybe I'll improve this someday or any other can pick this...

pretty Nothing (Just pkgName) = Just $ pkgName <> "\n"
pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n"
prettyName (Left m,_) = printOutputable m

prettyPackageName n = do
Expand All @@ -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
Expand All @@ -255,8 +258,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
-- do not show "at <no location info>" 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
Expand Down
7 changes: 5 additions & 2 deletions ghcide/src/Development/IDE/Spans/Common.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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) ->
Expand Down
6 changes: 4 additions & 2 deletions ghcide/test/exe/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"]]
Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down