From 1967271e6e2931144beb6b4ae28323bfdd759359 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 18 Apr 2026 13:28:02 +0800 Subject: [PATCH 1/9] feat: add hls-document-link-plugin --- haskell-language-server.cabal | 37 +++++ hls-plugin-api/src/Ide/Types.hs | 10 +- .../src/Ide/Plugin/DocumentLink.hs | 126 ++++++++++++++++++ src/HlsPlugins.hs | 7 + 4 files changed, 179 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 60d4a5c810..9fd47edbb3 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1176,6 +1176,42 @@ test-suite hls-code-range-plugin-tests , transformers , vector +----------------------------- +-- document link +----------------------------- + +flag documentLink + description: Enable documentLink plugin + default: True + manual: True + +common documentLink + if flag(documentLink) + build-depends: haskell-language-server:hls-document-link-plugin + cpp-options: -Dhls_documentLink + +library hls-document-link-plugin + import: defaults, pedantic, warnings + if !flag(documentLink) + buildable: False + exposed-modules: + Ide.Plugin.DocumentLink + hs-source-dirs: plugins/hls-document-link-plugin/src + build-depends: + , containers + , deepseq + , extra + , ghc + , ghcide == 2.13.0.0 + , hashable + , hls-plugin-api == 2.13.0.0 + , lens + , lsp + , mtl + , semigroupoids + , transformers + , vector + ----------------------------- -- change type signature plugin ----------------------------- @@ -1846,6 +1882,7 @@ library , hlint , stan , signatureHelp + , documentLink , pragmas , splice , alternateNumberFormat diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 96edee141c..e546e4000c 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -269,6 +269,7 @@ data PluginConfig = , plcSelectionRangeOn :: !Bool , plcFoldingRangeOn :: !Bool , plcSemanticTokensOn :: !Bool + , plcDocumentLinkOn :: !Bool , plcConfig :: !Object } deriving (Show,Eq) @@ -288,11 +289,12 @@ instance Default PluginConfig where , plcSelectionRangeOn = True , plcFoldingRangeOn = True , plcSemanticTokensOn = True + , plcDocumentLinkOn = True , plcConfig = mempty } instance ToJSON PluginConfig where - toJSON (PluginConfig g ch ca ih cl d h s sh c rn sr fr st cfg) = r + toJSON (PluginConfig g ch ca ih cl d h s sh c rn sr fr st dl cfg) = r where r = object [ "globalOn" .= g , "callHierarchyOn" .= ch @@ -308,6 +310,7 @@ instance ToJSON PluginConfig where , "selectionRangeOn" .= sr , "foldingRangeOn" .= fr , "semanticTokensOn" .= st + , "documentLinkOn" .= dl , "config" .= cfg ] @@ -613,6 +616,8 @@ instance PluginMethod Request Method_WorkspaceExecuteCommand where instance PluginMethod Request (Method_CustomMethod m) where handlesRequest _ _ _ _ _ = HandlesRequest +instance PluginMethod Request Method_TextDocumentDocumentLink where + -- Plugin Notifications instance PluginMethod Notification Method_TextDocumentDidOpen where @@ -844,6 +849,9 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where instance PluginRequestMethod Method_TextDocumentInlayHint where combineResponses _ _ _ _ x = sconcat x +instance PluginRequestMethod Method_TextDocumentDocumentLink where + + takeLefts :: [a |? b] -> [a] takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x]) diff --git a/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs b/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs new file mode 100644 index 0000000000..b21256ff4c --- /dev/null +++ b/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs @@ -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 + 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 + [] -> 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) diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 5a56aee686..18d9c2e095 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -131,6 +131,10 @@ import qualified Development.IDE.Plugin.CodeAction as Refactor import qualified Ide.Plugin.SemanticTokens as SemanticTokens #endif +#if hls_documentLink +import qualified Ide.Plugin.DocumentLink as DocumentLink +#endif + data Log = forall a. (Pretty a) => Log PluginId a @@ -247,5 +251,8 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins #endif #if hls_notes let pId = "notes" in Notes.descriptor (pluginRecorder pId) pId : +#endif +#if hls_documentLink + let pId = "documentLink" in DocumentLink.descriptor (pluginRecorder pId) pId: #endif GhcIde.descriptors (pluginRecorder "ghcide") From 7ee648a56ad51067fbff4f73399903b2067c2506 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 18 Apr 2026 13:29:53 +0800 Subject: [PATCH 2/9] test: hls-document-link-plugin golden test --- haskell-language-server.cabal | 16 +++ plugins/hls-document-link-plugin/test/Main.hs | 126 ++++++++++++++++++ .../test/testdata/Definition.hs | 4 + .../test/testdata/ImportModule.hs | 2 + .../test/testdata/NoDocumentLinks.hs | 1 + 5 files changed, 149 insertions(+) create mode 100644 plugins/hls-document-link-plugin/test/Main.hs create mode 100644 plugins/hls-document-link-plugin/test/testdata/Definition.hs create mode 100644 plugins/hls-document-link-plugin/test/testdata/ImportModule.hs create mode 100644 plugins/hls-document-link-plugin/test/testdata/NoDocumentLinks.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 9fd47edbb3..10b7379246 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1212,6 +1212,22 @@ library hls-document-link-plugin , transformers , vector +test-suite hls-document-link-plugin-tests + import: defaults, pedantic, test-defaults, warnings + if !flag(documentLink) + buildable: False + type: exitcode-stdio-1.0 + hs-source-dirs: plugins/hls-document-link-plugin/test + main-is: Main.hs + build-depends: + , ghcide + , filepath + , haskell-language-server:hls-document-link-plugin + , hls-test-utils == 2.13.0.0 + , text + , lens + , lsp-types + ----------------------------- -- change type signature plugin ----------------------------- diff --git a/plugins/hls-document-link-plugin/test/Main.hs b/plugins/hls-document-link-plugin/test/Main.hs new file mode 100644 index 0000000000..3ab6c7eb39 --- /dev/null +++ b/plugins/hls-document-link-plugin/test/Main.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +import Control.Exception (throw) +import Control.Lens hiding ((<.>)) +import Control.Monad (void) +import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Text as T +import Ide.Plugin.DocumentLink (descriptor) +import qualified Ide.Plugin.DocumentLink as DL +import qualified Language.LSP.Protocol.Lens as L +import System.FilePath +import Test.Hls +import qualified Test.Hls.FileSystem as FS + +testDataDir :: FilePath +testDataDir = "plugins" "hls-document-link-plugin" "test" "testdata" + +main :: IO () +main = defaultTestRunner tests + +tests :: TestTree +tests = testGroup "documentLink" + [ goldenTest "no document links" "NoDocumentLinks" [], + goldenTest "links of primitive types" "Definition" + [ (SimilarDocumentLink + (DocumentLink (Range (Position 0 10) (Position 0 13)) + (Just (Uri "GHC-Types.html#t:Int")) + Nothing + Nothing)), + (SimilarDocumentLink + (DocumentLink (Range (Position 2 10) (Position 2 14)) + (Just (Uri "GHC-Types.html#t:Bool")) + Nothing + Nothing)), + (SimilarDocumentLink + (DocumentLink (Range (Position 3 9) (Position 3 13)) + (Just (Uri "GHC-Types.html#v:True")) + Nothing + Nothing)) + ], + goldenTest "links from modules" "ImportModule" + [ (SimilarDocumentLink + (DocumentLink (Range (Position 0 19) (Position 0 27)) + (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + Nothing + Nothing)), + (SimilarDocumentLink + (DocumentLink (Range (Position 0 29) (Position 0 38)) + (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) + Nothing + Nothing)), + (SimilarDocumentLink + (DocumentLink (Range (Position 1 5) (Position 1 13)) + (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + Nothing + Nothing)), + (SimilarDocumentLink + (DocumentLink (Range (Position 1 15) (Position 1 24)) + (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) + Nothing + Nothing)) + ] + ] + +goldenTest :: TestName -> FilePath -> [SimilarDocumentLink] -> TestTree +goldenTest title file expected = testCase title $ runWithDocumentLink filehs $ do + adoc <- openDoc filehs "haskell" + void waitForBuildQueue + documentLink <- getDocumentLink adoc + liftIO $ ((fmap . fmap) SimilarDocumentLink documentLink) @?= Just expected + where filehs = file <.> "hs" + +runWithDocumentLink :: FilePath -> Session a -> IO a +runWithDocumentLink file = runSessionWithServerInTmpDir def plugin (mkFs $ FS.directProject file) + where plugin :: PluginTestDescriptor DL.Log + plugin = mkPluginTestDescriptor descriptor "documentLink" + mkFs :: [FS.FileTree] -> FS.VirtualFileTree + mkFs = FS.mkVirtualFileTree testDataDir + +getDocumentLink :: TextDocumentIdentifier -> Session (Maybe [DocumentLink]) +getDocumentLink doc = + let params = DocumentLinkParams Nothing Nothing doc + in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentDocumentLink params + + +getResponseResult :: (Show (ErrorData m)) => TResponseMessage m -> MessageResult m +getResponseResult rsp = + case rsp ^. L.result of + Right x -> x + Left err -> throw $ UnexpectedResponseError (fromJust $ rsp ^. L.id) err + +newtype SimilarDocumentLink = SimilarDocumentLink DocumentLink + deriving newtype (Show) + +-- custom Eq to ignore some details, such as specific URI +-- not symmetry +instance Eq SimilarDocumentLink where + SimilarDocumentLink actualDocumentLink@( DocumentLink + actualRange + actualUri + actualTooltip + actualData ) + == SimilarDocumentLink expectedDocumentLink@( DocumentLink + expectRange + expectUri + expectToolTip + expectData ) + | actualDocumentLink == expectedDocumentLink = True + | actualRange == expectRange + && actualTooltip == expectToolTip + && actualData == expectData + = actualUri ~= expectUri + | otherwise = False + +class IsSimilar a where + (~=) :: a -> a -> Bool + +instance (IsSimilar a) => IsSimilar (Maybe a) where + m1 ~= m2 = fromMaybe False $ liftA2 (~=) m1 m2 + +instance IsSimilar Uri where + (Uri actual) ~= (Uri except) + = except `T.isSuffixOf` actual diff --git a/plugins/hls-document-link-plugin/test/testdata/Definition.hs b/plugins/hls-document-link-plugin/test/testdata/Definition.hs new file mode 100644 index 0000000000..fb9bcbdc57 --- /dev/null +++ b/plugins/hls-document-link-plugin/test/testdata/Definition.hs @@ -0,0 +1,4 @@ +answer :: Int +answer = 42 +living :: Bool +living = True diff --git a/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs b/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs new file mode 100644 index 0000000000..7a17f6b766 --- /dev/null +++ b/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs @@ -0,0 +1,2 @@ +import Data.Maybe (fromJust, fromMaybe) +f = (fromJust, fromMaybe) diff --git a/plugins/hls-document-link-plugin/test/testdata/NoDocumentLinks.hs b/plugins/hls-document-link-plugin/test/testdata/NoDocumentLinks.hs new file mode 100644 index 0000000000..662527ea76 --- /dev/null +++ b/plugins/hls-document-link-plugin/test/testdata/NoDocumentLinks.hs @@ -0,0 +1 @@ +answer = 42 From 382b87a11d9199cc81ef7b8ccc33f5198076c6da Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 18 Apr 2026 13:31:43 +0800 Subject: [PATCH 3/9] feat: add documentLinkOn config --- hls-plugin-api/src/Ide/Plugin/Config.hs | 1 + hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index ecaf5f5d41..045be02359 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -78,6 +78,7 @@ parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def + <*> o .:? "documentLinkOn" .!= plcDocumentLinkOn def <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index f352cc179d..5fb3660d65 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -109,6 +109,7 @@ pluginsToDefaultConfig IdePlugins {..} = SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn] SMethod_TextDocumentSemanticTokensFull -> ["semanticTokensOn" A..= plcSemanticTokensOn] SMethod_TextDocumentSemanticTokensFullDelta -> ["semanticTokensOn" A..= plcSemanticTokensOn] + SMethod_TextDocumentDocumentLink -> ["documentLinkOn" A..= plcDocumentLinkOn] _ -> [] -- | Generates json schema used in haskell vscode extension From a8c349205fbaf6df85ad750182b7689f0563df18 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 18 Apr 2026 13:32:02 +0800 Subject: [PATCH 4/9] test: update default-config --- test/testdata/schema/ghc910/default-config.golden.json | 3 +++ test/testdata/schema/ghc912/default-config.golden.json | 3 +++ test/testdata/schema/ghc914/default-config.golden.json | 3 +++ test/testdata/schema/ghc96/default-config.golden.json | 3 +++ test/testdata/schema/ghc98/default-config.golden.json | 3 +++ 5 files changed, 15 insertions(+) diff --git a/test/testdata/schema/ghc910/default-config.golden.json b/test/testdata/schema/ghc910/default-config.golden.json index 0c0704b257..cd22a0b7e0 100644 --- a/test/testdata/schema/ghc910/default-config.golden.json +++ b/test/testdata/schema/ghc910/default-config.golden.json @@ -38,6 +38,9 @@ "codeActionsOn": true, "codeLensOn": true }, + "documentLink": { + "globalOn": true + }, "eval": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc912/default-config.golden.json b/test/testdata/schema/ghc912/default-config.golden.json index 40c7b5b03a..381cb335c5 100644 --- a/test/testdata/schema/ghc912/default-config.golden.json +++ b/test/testdata/schema/ghc912/default-config.golden.json @@ -38,6 +38,9 @@ "codeActionsOn": true, "codeLensOn": true }, + "documentLink": { + "globalOn": true + }, "eval": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc914/default-config.golden.json b/test/testdata/schema/ghc914/default-config.golden.json index f94188128b..0bf5a3d062 100644 --- a/test/testdata/schema/ghc914/default-config.golden.json +++ b/test/testdata/schema/ghc914/default-config.golden.json @@ -38,6 +38,9 @@ "codeActionsOn": true, "codeLensOn": true }, + "documentLink": { + "globalOn": true + }, "eval": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 9073784a75..691126bea3 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -38,6 +38,9 @@ "codeActionsOn": true, "codeLensOn": true }, + "documentLink": { + "globalOn": true + }, "eval": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 9073784a75..691126bea3 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -38,6 +38,9 @@ "codeActionsOn": true, "codeLensOn": true }, + "documentLink": { + "globalOn": true + }, "eval": { "codeActionsOn": true, "codeLensOn": true, From 0353713c06dfad40e89582594f588db2e150a0c4 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 18 Apr 2026 13:44:55 +0800 Subject: [PATCH 5/9] doc(features): support documentLink --- docs/features.md | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/docs/features.md b/docs/features.md index 449db37c7f..7db7fb93a3 100644 --- a/docs/features.md +++ b/docs/features.md @@ -22,6 +22,7 @@ Many of these are standard LSP features, but a lot of special features are provi | [Selection range](#selection-range) | `textDocument/selectionRange` | | [Rename](#rename) | `textDocument/rename` | | [Semantic tokens](#semantic-tokens) | `textDocument/semanticTokens/full` | +| [Document links](#document-links) | `textDocument/documentLink` | The individual sections below also identify which [HLS plugin](./what-is-hls.md#hls-plugins) is responsible for providing the given functionality, which is useful if you want to raise an issue report or contribute! Additionally, not all plugins are supported on all versions of GHC, see the [plugin support page](./support/plugin-support.md) for details. @@ -434,6 +435,13 @@ Provided by: `hls-semantic-tokens-plugin` Provides semantic tokens for each token in the source code to support semantic highlighting. +## Document links + +Provided by: `hls-document-link-plugin` + +Extracts clickable links (e.g., URLs in Haddock comments) and makes them available as LSP document links. +This allows editors to open the linked resource directly from the source code. + ## Rewrite to overloaded record syntax Provided by: `hls-overloaded-record-dot-plugin` @@ -454,7 +462,6 @@ Contributions welcome! | Jump to declaration | Unclear if useful | `textDocument/declaration` | | Jump to implementation | Unclear if useful | `textDocument/implementation` | | Linked editing | Unimplemented | `textDocument/linkedEditingRange` | -| Document links | Unimplemented | `textDocument/documentLink` | | Document color | Unclear if useful | `textDocument/documentColor` | | Color presentation | Unclear if useful | `textDocument/colorPresentation` | | Monikers | Unclear if useful | `textDocument/moniker` | From fbe109e2d88c56c51c08dd1330349ede05667a85 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 19 Apr 2026 00:46:17 +0800 Subject: [PATCH 6/9] refactor: use mkDocLink to reduce template code --- plugins/hls-document-link-plugin/test/Main.hs | 54 ++++++------------- 1 file changed, 15 insertions(+), 39 deletions(-) diff --git a/plugins/hls-document-link-plugin/test/Main.hs b/plugins/hls-document-link-plugin/test/Main.hs index 3ab6c7eb39..61ba205d6e 100644 --- a/plugins/hls-document-link-plugin/test/Main.hs +++ b/plugins/hls-document-link-plugin/test/Main.hs @@ -23,48 +23,24 @@ main = defaultTestRunner tests tests :: TestTree tests = testGroup "documentLink" - [ goldenTest "no document links" "NoDocumentLinks" [], - goldenTest "links of primitive types" "Definition" - [ (SimilarDocumentLink - (DocumentLink (Range (Position 0 10) (Position 0 13)) - (Just (Uri "GHC-Types.html#t:Int")) - Nothing - Nothing)), - (SimilarDocumentLink - (DocumentLink (Range (Position 2 10) (Position 2 14)) - (Just (Uri "GHC-Types.html#t:Bool")) - Nothing - Nothing)), - (SimilarDocumentLink - (DocumentLink (Range (Position 3 9) (Position 3 13)) - (Just (Uri "GHC-Types.html#v:True")) - Nothing - Nothing)) - ], - goldenTest "links from modules" "ImportModule" - [ (SimilarDocumentLink - (DocumentLink (Range (Position 0 19) (Position 0 27)) - (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) - Nothing - Nothing)), - (SimilarDocumentLink - (DocumentLink (Range (Position 0 29) (Position 0 38)) - (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) - Nothing - Nothing)), - (SimilarDocumentLink - (DocumentLink (Range (Position 1 5) (Position 1 13)) - (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) - Nothing - Nothing)), - (SimilarDocumentLink - (DocumentLink (Range (Position 1 15) (Position 1 24)) - (Just (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) - Nothing - Nothing)) + [ goldenTest "no document links" "NoDocumentLinks" [] + , goldenTest "links of primitive types" "Definition" + [ (mkDocLink (mkRange 0 10 0 13) (Uri "GHC-Types.html#t:Int")) + , (mkDocLink (mkRange 2 10 2 14) (Uri "GHC-Types.html#t:Bool")) + , (mkDocLink (mkRange 3 9 3 13) (Uri "GHC-Types.html#v:True")) + ] + , goldenTest "links from modules" "ImportModule" + [ (mkDocLink (mkRange 0 19 0 27) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + , (mkDocLink (mkRange 0 29 0 38) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) + , (mkDocLink (mkRange 1 5 1 13) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + , (mkDocLink (mkRange 1 15 1 24) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) ] ] +mkDocLink :: Range -> Uri -> SimilarDocumentLink +mkDocLink range uri = + SimilarDocumentLink (DocumentLink range (Just uri) Nothing Nothing) + goldenTest :: TestName -> FilePath -> [SimilarDocumentLink] -> TestTree goldenTest title file expected = testCase title $ runWithDocumentLink filehs $ do adoc <- openDoc filehs "haskell" From e644d724243164cfe02001227fb8b6d4be61346d Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 19 Apr 2026 00:48:04 +0800 Subject: [PATCH 7/9] refactor(hls-document-link-plugin): not goldenTest --- plugins/hls-document-link-plugin/test/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/hls-document-link-plugin/test/Main.hs b/plugins/hls-document-link-plugin/test/Main.hs index 61ba205d6e..79fcd6e935 100644 --- a/plugins/hls-document-link-plugin/test/Main.hs +++ b/plugins/hls-document-link-plugin/test/Main.hs @@ -23,13 +23,13 @@ main = defaultTestRunner tests tests :: TestTree tests = testGroup "documentLink" - [ goldenTest "no document links" "NoDocumentLinks" [] - , goldenTest "links of primitive types" "Definition" + [ mkTest "no document links" "NoDocumentLinks" [] + , mkTest "links of primitive types" "Definition" [ (mkDocLink (mkRange 0 10 0 13) (Uri "GHC-Types.html#t:Int")) , (mkDocLink (mkRange 2 10 2 14) (Uri "GHC-Types.html#t:Bool")) , (mkDocLink (mkRange 3 9 3 13) (Uri "GHC-Types.html#v:True")) ] - , goldenTest "links from modules" "ImportModule" + , mkTest "links from modules" "ImportModule" [ (mkDocLink (mkRange 0 19 0 27) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) , (mkDocLink (mkRange 0 29 0 38) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) , (mkDocLink (mkRange 1 5 1 13) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) @@ -41,8 +41,8 @@ mkDocLink :: Range -> Uri -> SimilarDocumentLink mkDocLink range uri = SimilarDocumentLink (DocumentLink range (Just uri) Nothing Nothing) -goldenTest :: TestName -> FilePath -> [SimilarDocumentLink] -> TestTree -goldenTest title file expected = testCase title $ runWithDocumentLink filehs $ do +mkTest :: TestName -> FilePath -> [SimilarDocumentLink] -> TestTree +mkTest title file expected = testCase title $ runWithDocumentLink filehs $ do adoc <- openDoc filehs "haskell" void waitForBuildQueue documentLink <- getDocumentLink adoc From 93d28360fbcd08eae991f71a7ae03c0d2b05e7c3 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 19 Apr 2026 01:01:47 +0800 Subject: [PATCH 8/9] test: more import test --- plugins/hls-document-link-plugin/test/Main.hs | 14 +++++++++----- .../test/testdata/ImportModule.hs | 3 ++- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/plugins/hls-document-link-plugin/test/Main.hs b/plugins/hls-document-link-plugin/test/Main.hs index 79fcd6e935..5a49be2da9 100644 --- a/plugins/hls-document-link-plugin/test/Main.hs +++ b/plugins/hls-document-link-plugin/test/Main.hs @@ -27,13 +27,17 @@ tests = testGroup "documentLink" , mkTest "links of primitive types" "Definition" [ (mkDocLink (mkRange 0 10 0 13) (Uri "GHC-Types.html#t:Int")) , (mkDocLink (mkRange 2 10 2 14) (Uri "GHC-Types.html#t:Bool")) - , (mkDocLink (mkRange 3 9 3 13) (Uri "GHC-Types.html#v:True")) + , (mkDocLink (mkRange 3 9 3 13) (Uri "GHC-Types.html#v:True")) ] , mkTest "links from modules" "ImportModule" - [ (mkDocLink (mkRange 0 19 0 27) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) - , (mkDocLink (mkRange 0 29 0 38) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) - , (mkDocLink (mkRange 1 5 1 13) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) - , (mkDocLink (mkRange 1 15 1 24) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) + [ (mkDocLink (mkRange 0 20 0 28) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + , (mkDocLink (mkRange 0 30 0 39) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) + , (mkDocLink (mkRange 0 41 0 46) (Uri "GHC-Internal-Maybe.html#t:Maybe")) + , (mkDocLink (mkRange 0 47 0 51) (Uri "GHC-Internal-Maybe.html#v:Just")) + , (mkDocLink (mkRange 0 53 0 60) (Uri "GHC-Internal-Maybe.html#v:Nothing")) + , (mkDocLink (mkRange 1 20 1 26) (Uri "GHC-Internal-Data-Either.html#t:Either")) + , (mkDocLink (mkRange 2 5 2 13) (Uri "GHC-Internal-Data-Maybe.html#v:fromJust")) + , (mkDocLink (mkRange 2 15 2 24) (Uri "GHC-Internal-Data-Maybe.html#v:fromMaybe")) ] ] diff --git a/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs b/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs index 7a17f6b766..6d7cbf1243 100644 --- a/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs +++ b/plugins/hls-document-link-plugin/test/testdata/ImportModule.hs @@ -1,2 +1,3 @@ -import Data.Maybe (fromJust, fromMaybe) +import Data.Maybe (fromJust, fromMaybe, Maybe(Just, Nothing)) +import Data.Either (Either (..)) f = (fromJust, fromMaybe) From 24826fc5644d8fcca7078a6705bba76f8eb46728 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Wed, 22 Apr 2026 16:34:37 +0800 Subject: [PATCH 9/9] refactor: random improve --- .../src/Ide/Plugin/DocumentLink.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs b/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs index b21256ff4c..12e5a811b7 100644 --- a/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs +++ b/plugins/hls-document-link-plugin/src/Ide/Plugin/DocumentLink.hs @@ -58,9 +58,8 @@ import Language.LSP.Protocol.Types (DocumentLink (..), newtype Log = LogShake Shake.Log instance Pretty Log where - pretty = \case { + pretty = \case LogShake shakeLog -> pretty shakeLog - } descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder pluginId = @@ -101,12 +100,16 @@ 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 + ast <- hoistMaybe $ getAsts hieAst Map.!? HiePath (mkFastString $ fromNormalizedFilePath nfp) let lookup = lookupDoc getDocMap pure $ DocumentLinks (foldAst lookup ast) +-- | Recursively traverses the HieAST in depth-first order to collect information +-- from leaf nodes. For each leaf, it extracts all identifiers and their source +-- spans, applies the lookup function, and aggregates the results using the +-- Monoid instance. foldAst :: forall a t. Monoid a => ((Identifier, Span) -> a) -> HieAST t -> a -foldAst lookup ast = case (nodeChildren ast) of +foldAst lookup ast = case nodeChildren ast of [] -> visitLeaf ast asts -> foldMap (foldAst lookup) asts where