feat: add hls-document-link-plugin to support LSP document links
#4898
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change | ||||
|---|---|---|---|---|---|---|
| @@ -0,0 +1,126 @@ | ||||||
| {-# LANGUAGE DataKinds #-} | ||||||
| {-# LANGUAGE DisambiguateRecordFields #-} | ||||||
| {-# LANGUAGE LambdaCase #-} | ||||||
| {-# LANGUAGE OverloadedStrings #-} | ||||||
| {-# LANGUAGE PatternSynonyms #-} | ||||||
| {-# LANGUAGE StrictData #-} | ||||||
| {-# LANGUAGE TypeFamilies #-} | ||||||
|
|
||||||
| module Ide.Plugin.DocumentLink (descriptor, Log(..)) where | ||||||
|
|
||||||
| import Control.DeepSeq (NFData) | ||||||
| import Control.Monad.Trans.Maybe (MaybeT (runMaybeT), | ||||||
| hoistMaybe) | ||||||
| import Data.Hashable (Hashable) | ||||||
| import qualified Data.Map.Strict as Map | ||||||
| import Data.Maybe (maybeToList) | ||||||
| import Development.IDE (DocAndTyThingMap (DKMap, getDocMap), | ||||||
| GetDocMap (GetDocMap), | ||||||
| GetHieAst (GetHieAst), | ||||||
| HieAstResult (HAR, hieAst), | ||||||
| IdeState (shakeExtras), | ||||||
| Pretty (pretty), Range, | ||||||
| Recorder, RuleResult, Rules, | ||||||
| Uri (Uri), WithPriority, | ||||||
| cmapWithPrio, | ||||||
| defineNoDiagnostics, | ||||||
| fromNormalizedFilePath, | ||||||
| realSrcSpanToRange) | ||||||
| import Development.IDE.Core.PluginUtils (runIdeActionE, useMT, | ||||||
| useWithStaleFastE) | ||||||
| import qualified Development.IDE.Core.Shake as Shake | ||||||
| import Development.IDE.GHC.Compat (lookupNameEnv) | ||||||
| import Development.IDE.GHC.Compat.Util (mkFastString) | ||||||
| import Development.IDE.Spans.Common (DocMap, | ||||||
| SpanDoc (SpanDocString, SpanDocText), | ||||||
| spanDocUriDoc) | ||||||
| import GHC.Generics (Generic) | ||||||
| import GHC.Iface.Ext.Types (HieAST (nodeChildren, nodeSpan, sourcedNodeInfo), | ||||||
| HieASTs (getAsts), | ||||||
| Identifier, | ||||||
| NodeInfo (nodeIdentifiers), | ||||||
| NodeOrigin (SourceInfo), | ||||||
| SourcedNodeInfo (getSourcedNodeInfo), | ||||||
| Span, pattern HiePath) | ||||||
| import Ide.Plugin.Error (getNormalizedFilePathE) | ||||||
| import Ide.Types (PluginDescriptor (pluginHandlers), | ||||||
| PluginId, | ||||||
| PluginMethodHandler, | ||||||
| defaultPluginDescriptor, | ||||||
| mkPluginHandler, pluginRules) | ||||||
| import Language.LSP.Protocol.Message (Method (Method_TextDocumentDocumentLink), | ||||||
| SMethod (SMethod_TextDocumentDocumentLink)) | ||||||
| import Language.LSP.Protocol.Types (DocumentLink (..), | ||||||
| DocumentLinkParams (DocumentLinkParams), | ||||||
| TextDocumentIdentifier (TextDocumentIdentifier), | ||||||
| type (|?) (InL)) | ||||||
|
|
||||||
| newtype Log = LogShake Shake.Log | ||||||
|
|
||||||
| instance Pretty Log where | ||||||
| pretty = \case { | ||||||
| LogShake shakeLog -> pretty shakeLog | ||||||
| } | ||||||
|
|
||||||
| descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState | ||||||
| descriptor recorder pluginId = | ||||||
| (defaultPluginDescriptor pluginId "Provide document link of symbols") | ||||||
| { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDocumentLink documentLinkProvider, | ||||||
| Ide.Types.pluginRules = getDocumentLinkRule recorder | ||||||
| } | ||||||
|
|
||||||
| documentLinkProvider :: PluginMethodHandler IdeState Method_TextDocumentDocumentLink | ||||||
| documentLinkProvider ideState _pluginId (DocumentLinkParams _ _ (TextDocumentIdentifier uri)) = do | ||||||
| nfp <- getNormalizedFilePathE uri | ||||||
| ((DocumentLinks uris), _pm) <- runIdeActionE "DocumentLink" (shakeExtras ideState) $ useWithStaleFastE GetDocumentLinks nfp | ||||||
| pure $ InL (map mkDocumentLink uris) | ||||||
|
|
||||||
| mkDocumentLink :: (Range, Uri) -> DocumentLink | ||||||
| mkDocumentLink (range, target) = | ||||||
| DocumentLink | ||||||
| { _range = range, | ||||||
| _target = Just target, | ||||||
| _tooltip = Nothing, | ||||||
| _data_ = Nothing | ||||||
| } | ||||||
|
|
||||||
| data GetDocumentLinks = GetDocumentLinks | ||||||
| deriving (Eq, Show, Generic) | ||||||
|
|
||||||
| instance Hashable GetDocumentLinks | ||||||
|
|
||||||
| instance NFData GetDocumentLinks | ||||||
|
|
||||||
| newtype DocumentLinks = DocumentLinks [(Range, Uri)] | ||||||
| deriving (Show, NFData) | ||||||
|
|
||||||
| type instance RuleResult GetDocumentLinks = DocumentLinks | ||||||
|
|
||||||
| getDocumentLinkRule :: Recorder (WithPriority Log) -> Rules () | ||||||
| getDocumentLinkRule recorder = | ||||||
| defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetDocumentLinks nfp -> runMaybeT $ do | ||||||
| HAR {hieAst} <- useMT GetHieAst nfp | ||||||
| DKMap {getDocMap} <- useMT GetDocMap nfp | ||||||
| ast <- hoistMaybe $ getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp | ||||||
|
Collaborator
There was a problem hiding this comment.
Suggested change
Just weird bracketing for my taste, feel free to ignore. |
||||||
| let lookup = lookupDoc getDocMap | ||||||
| pure $ DocumentLinks (foldAst lookup ast) | ||||||
|
|
||||||
| foldAst :: forall a t. Monoid a => ((Identifier, Span) -> a) -> HieAST t -> a | ||||||
| foldAst lookup ast = case (nodeChildren ast) of | ||||||
|
Collaborator
There was a problem hiding this comment.
Suggested change
Comment on lines
+108
to
+109
Collaborator
There was a problem hiding this comment. Some docs would be nice, what is this folding over? |
||||||
| [] -> visitLeaf ast | ||||||
| asts -> foldMap (foldAst lookup) asts | ||||||
| where | ||||||
| visitLeaf leaf = | ||||||
| let span = nodeSpan leaf | ||||||
| mNodeInfo = Map.lookup SourceInfo $ getSourcedNodeInfo (sourcedNodeInfo leaf) | ||||||
| in flip foldMap mNodeInfo $ \nodeInfo -> | ||||||
| foldMap (\ident -> lookup (ident, span)) (Map.keys $ nodeIdentifiers nodeInfo) | ||||||
|
|
||||||
| lookupDoc :: DocMap -> (Identifier, Span) -> [(Range, Uri)] | ||||||
| lookupDoc dm (identifier, span) = do | ||||||
| Right name <- [identifier] | ||||||
| doc <- maybeToList $ lookupNameEnv dm name | ||||||
| uris <- maybeToList $ spanDocUriDoc $ case doc of | ||||||
| SpanDocString _ uris -> uris | ||||||
| SpanDocText _ uris -> uris | ||||||
| pure (realSrcSpanToRange span, Uri uris) | ||||||
Oops, something went wrong.
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.