@@ -13,22 +13,26 @@ module Development.IDE.Spans.Common (
13
13
, spanDocToMarkdownForTest
14
14
, DocMap
15
15
, TyThingMap
16
+ , srcSpanToMdLink
16
17
) where
17
18
18
19
import Control.DeepSeq
20
+ import Data.Bifunctor (second )
19
21
import Data.List.Extra
20
22
import Data.Maybe
21
23
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
24
27
import GHC
28
+ import GHC.Generics
29
+ import System.FilePath
25
30
26
- import Data.Bifunctor ( second )
31
+ import Control.Lens
27
32
import Development.IDE.GHC.Compat
28
33
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
32
36
33
37
type DocMap = NameEnv SpanDoc
34
38
type TyThingMap = NameEnv TyThing
@@ -109,7 +113,13 @@ spanDocUrisToMarkdown (SpanDocUris mdoc msrc) = catMaybes
109
113
[ linkify " Documentation" <$> mdoc
110
114
, linkify " Source" <$> msrc
111
115
]
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 <> " )"
113
123
114
124
spanDocToMarkdownForTest :: String -> String
115
125
spanDocToMarkdownForTest
@@ -215,3 +225,35 @@ splitForList s
215
225
= case lines s of
216
226
[] -> " "
217
227
(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