Skip to content

Commit eed6ba4

Browse files
committed
Add pretty link for source location to hover
1 parent 25f17fb commit eed6ba4

File tree

2 files changed

+54
-10
lines changed

2 files changed

+54
-10
lines changed

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

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -335,7 +335,7 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D
335335
-- We want to render the root constraint even if it is a let,
336336
-- but we don't want to render any subsequent lets
337337
renderEvidenceTree :: Tree (EvidenceInfo a) -> SDoc
338-
-- However, if the root constraint is simply an indirection (via let) to a single other constraint,
338+
-- However, if the root constraint is simply a<n indirection (via let) to a single other constraint,
339339
-- we can still skip rendering it
340340
renderEvidenceTree (T.Node (EvidenceInfo{evidenceDetails=Just (EvLetBind _,_,_)}) [x])
341341
= renderEvidenceTree x
@@ -351,13 +351,15 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D
351351
= vcat (map renderEvidenceTree' xs)
352352
renderEvidenceTree' (T.Node (EvidenceInfo{..}) _)
353353
= hang (text "- `" O.<> expandType evidenceType O.<> "`") 2 $
354-
vcat $ printDets evidenceSpan evidenceDetails : map (text . T.unpack) (maybeToList $ definedAt evidenceVar)
354+
vcat $
355+
printDets evidenceSpan evidenceDetails : map (text . T.unpack) (maybeToList $ definedAt evidenceVar)
355356

356357
printDets :: RealSrcSpan -> Maybe (EvVarSource, Scope, Maybe Span) -> SDoc
357358
printDets _ Nothing = text "using an external instance"
358359
printDets ospn (Just (src,_,mspn)) = pprSrc
359-
$$ text "at" <+> ppr spn
360+
$$ text "at" <+> text (T.unpack $ srcSpanToMdLink location)
360361
where
362+
location = realSrcSpanToLocation $ traceShowId spn
361363
-- Use the bind span if we have one, else use the occurrence span
362364
spn = fromMaybe ospn mspn
363365
pprSrc = case src of

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

Lines changed: 49 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -13,22 +13,26 @@ module Development.IDE.Spans.Common (
1313
, spanDocToMarkdownForTest
1414
, DocMap
1515
, TyThingMap
16+
, srcSpanToMdLink
1617
) where
1718

1819
import Control.DeepSeq
20+
import Data.Bifunctor (second)
1921
import Data.List.Extra
2022
import Data.Maybe
2123
import qualified Data.Text as T
22-
import GHC.Generics
23-
24+
import Development.IDE.GHC.Util
25+
import qualified Documentation.Haddock.Parser as H
26+
import qualified Documentation.Haddock.Types as H
2427
import GHC
28+
import GHC.Generics
29+
import System.FilePath
2530

26-
import Data.Bifunctor (second)
31+
import Control.Lens
2732
import Development.IDE.GHC.Compat
2833
import Development.IDE.GHC.Orphans ()
29-
import Development.IDE.GHC.Util
30-
import qualified Documentation.Haddock.Parser as H
31-
import qualified Documentation.Haddock.Types as H
34+
import qualified Language.LSP.Protocol.Lens as JL
35+
import Language.LSP.Protocol.Types
3236

3337
type DocMap = NameEnv SpanDoc
3438
type TyThingMap = NameEnv TyThing
@@ -109,7 +113,13 @@ spanDocUrisToMarkdown (SpanDocUris mdoc msrc) = catMaybes
109113
[ linkify "Documentation" <$> mdoc
110114
, linkify "Source" <$> msrc
111115
]
112-
where linkify title uri = "[" <> title <> "](" <> uri <> ")"
116+
117+
-- | Generate a markdown link.
118+
--
119+
-- >>> linkify "Title" "uri"
120+
-- "[Title](Uri)"
121+
linkify :: T.Text -> T.Text -> T.Text
122+
linkify title uri = "[" <> title <> "](" <> uri <> ")"
113123

114124
spanDocToMarkdownForTest :: String -> String
115125
spanDocToMarkdownForTest
@@ -215,3 +225,35 @@ splitForList s
215225
= case lines s of
216226
[] -> ""
217227
(first:rest) -> unlines $ first : map ((" " ++) . trimStart) rest
228+
229+
-- | Generate a source link for the 'Location' according to VSCode's supported form:
230+
-- https://github.com/microsoft/vscode/blob/b3ec8181fc49f5462b5128f38e0723ae85e295c2/src/vs/platform/opener/common/opener.ts#L151-L160
231+
--
232+
srcSpanToMdLink :: Location -> T.Text
233+
srcSpanToMdLink location =
234+
let
235+
uri = location ^. JL.uri
236+
range = location ^. JL.range
237+
-- LSP 'Range' starts at '0', but link locations start at '1'.
238+
intText n = T.pack $ show (n + 1)
239+
srcRangeText =
240+
T.concat
241+
[ "L"
242+
, intText (range ^. JL.start . JL.line)
243+
, ","
244+
, intText (range ^. JL.start . JL.character)
245+
, "-L"
246+
, intText (range ^. JL.end . JL.line)
247+
, ","
248+
, intText (range ^. JL.end . JL.character)
249+
]
250+
251+
-- If the 'Location' is a 'FilePath', display it in shortened form.
252+
-- This avoids some redundancy and better readability for the user.
253+
title = case uriToFilePath uri of
254+
Just fp -> T.pack (takeFileName fp) <> ":" <> intText (range ^. JL.start . JL.line)
255+
Nothing -> getUri uri
256+
257+
srcLink = getUri uri <> "#" <> srcRangeText
258+
in
259+
linkify title srcLink

0 commit comments

Comments
 (0)