Skip to content

Commit 9bbf42a

Browse files
committed
Use Nothing for original selection when upgrading Location to LocationLink
in combineResponses of plugins to TextDocumentDefinition message
1 parent d935655 commit 9bbf42a

File tree

4 files changed

+172
-16
lines changed

4 files changed

+172
-16
lines changed

hls-plugin-api/hls-plugin-api.cabal

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -34,15 +34,15 @@ source-repository head
3434

3535
library
3636
exposed-modules:
37-
Ide.Plugin.Error
37+
Ide.Logger
3838
Ide.Plugin.Config
3939
Ide.Plugin.ConfigUtils
40+
Ide.Plugin.Error
4041
Ide.Plugin.Properties
4142
Ide.Plugin.RangeMap
4243
Ide.Plugin.Resolve
4344
Ide.PluginUtils
4445
Ide.Types
45-
Ide.Logger
4646

4747
hs-source-dirs: src
4848
build-depends:
@@ -59,10 +59,11 @@ library
5959
, filepath
6060
, ghc
6161
, hashable
62-
, hls-graph == 2.4.0.0
62+
, hls-graph ==2.4.0.0
6363
, lens
6464
, lens-aeson
6565
, lsp ^>=2.2
66+
, megaparsec >=9.0
6667
, mtl
6768
, opentelemetry >=0.4
6869
, optparse-applicative
@@ -75,7 +76,6 @@ library
7576
, transformers
7677
, unliftio
7778
, unordered-containers
78-
, megaparsec > 9
7979

8080
if os(windows)
8181
build-depends: Win32
@@ -85,14 +85,13 @@ library
8585

8686
ghc-options:
8787
-Wall -Wredundant-constraints -Wno-name-shadowing
88-
-Wno-unticked-promoted-constructors
89-
-Wunused-packages
88+
-Wno-unticked-promoted-constructors -Wunused-packages
9089

9190
if flag(pedantic)
9291
ghc-options: -Werror
9392

9493
if flag(use-fingertree)
95-
cpp-options: -DUSE_FINGERTREE
94+
cpp-options: -DUSE_FINGERTREE
9695
build-depends: hw-fingertree
9796

9897
default-language: Haskell2010
@@ -107,33 +106,39 @@ test-suite tests
107106
hs-source-dirs: test
108107
main-is: Main.hs
109108
ghc-options: -threaded -rtsopts -with-rtsopts=-N
110-
other-modules: Ide.PluginUtilsTest
109+
other-modules:
110+
Ide.PluginUtilsTest
111+
Ide.TypesTests
112+
111113
build-depends:
112-
base
114+
, base
115+
, containers
116+
, data-default
113117
, hls-plugin-api
118+
, lens
119+
, lsp-types
114120
, tasty
115121
, tasty-hunit
116-
, tasty-rerun
117122
, tasty-quickcheck
123+
, tasty-rerun
118124
, text
119-
, lsp-types
120-
, containers
121125

122126
benchmark rangemap-benchmark
123127
-- Benchmark doesn't make sense if fingertree implementation
124128
-- is not used.
125129
if !flag(use-fingertree)
126130
buildable: False
131+
127132
type: exitcode-stdio-1.0
128133
default-language: Haskell2010
129134
hs-source-dirs: bench
130135
main-is: Main.hs
131136
ghc-options: -threaded -Wall
132137
build-depends:
133-
base
138+
, base
139+
, criterion
140+
, deepseq
134141
, hls-plugin-api
135142
, lsp-types
136-
, criterion
137143
, random
138144
, random-fu
139-
, deepseq

hls-plugin-api/src/Ide/Types.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -710,7 +710,7 @@ mergeDefinitions definitions1 definitions2 = case (definitions1, definitions2) o
710710
defToLinks (Definition (InR locations)) = map (DefinitionLink . locationToLocationLink) locations
711711

712712
locationToLocationLink :: Location -> LocationLink
713-
locationToLocationLink Location{_uri, _range} = LocationLink{_originSelectionRange = Just _range, _targetUri = _uri, _targetRange = _range, _targetSelectionRange = _range}
713+
locationToLocationLink Location{_uri, _range} = LocationLink{_originSelectionRange = Nothing, _targetUri = _uri, _targetRange = _range, _targetSelectionRange = _range}
714714
-- ---------------------------------------------------------------------
715715
-- Plugin Notifications
716716
-- ---------------------------------------------------------------------

hls-plugin-api/test/Ide/TypesTests.hs

Lines changed: 149 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
1+
{-# LANGUAGE DerivingStrategies #-}
2+
{-# LANGUAGE TypeOperators #-}
3+
module Ide.TypesTests
4+
( tests
5+
) where
6+
import Control.Lens ((?~))
7+
import Data.Default (Default (def))
8+
import Data.Function ((&))
9+
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
10+
import qualified Data.Text as Text
11+
import Ide.Types (Config (Config),
12+
PluginRequestMethod (combineResponses))
13+
import qualified Language.LSP.Protocol.Lens as L
14+
import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition),
15+
SMethod (..))
16+
import Language.LSP.Protocol.Types (ClientCapabilities,
17+
Definition (Definition),
18+
DefinitionClientCapabilities (DefinitionClientCapabilities, _dynamicRegistration, _linkSupport),
19+
DefinitionLink (DefinitionLink),
20+
DefinitionParams (DefinitionParams, _partialResultToken, _position, _textDocument, _workDoneToken),
21+
Location (Location),
22+
LocationLink (LocationLink),
23+
Null (Null),
24+
Position (Position),
25+
Range (Range),
26+
TextDocumentClientCapabilities (TextDocumentClientCapabilities, _definition),
27+
TextDocumentIdentifier (TextDocumentIdentifier),
28+
Uri (Uri), filePathToUri,
29+
type (|?) (..))
30+
import Test.Tasty (TestTree, testGroup)
31+
import Test.Tasty.HUnit (assertBool, testCase, (@=?))
32+
33+
tests :: TestTree
34+
tests = testGroup "PluginTypes"
35+
[ combineResponsesTests ]
36+
37+
combineResponsesTests :: TestTree
38+
combineResponsesTests = testGroup "combineResponses"
39+
[ combineResponsesTextDocumentDefinitionTests
40+
]
41+
42+
combineResponsesTextDocumentDefinitionTests :: TestTree
43+
combineResponsesTextDocumentDefinitionTests = testGroup "TextDocumentDefinition"
44+
[ testCase "merges all single location responses into one response with all locations and upgrades them into links (with link support)" $ do
45+
let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null))
46+
pluginResponses =
47+
(InL . Definition . InL . Location testFileUri $ range1) :|
48+
[ InL . Definition . InL . Location testFileUri $ range2
49+
, InL . Definition . InL . Location testFileUri $ range3
50+
]
51+
52+
result = combineResponses SMethod_TextDocumentDefinition def supportsLinkInDefinitionCaps definitionParams pluginResponses
53+
54+
expectedResult :: Definition |? ([DefinitionLink] |? Null)
55+
expectedResult = InR . InL $
56+
[ DefinitionLink $ LocationLink Nothing testFileUri range1 range1
57+
, DefinitionLink $ LocationLink Nothing testFileUri range2 range2
58+
, DefinitionLink $ LocationLink Nothing testFileUri range3 range3
59+
]
60+
expectedResult @=? result
61+
62+
, testCase "merges all location link responses into one with all links (with link support)" $ do
63+
let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null))
64+
pluginResponses =
65+
(InR . InL $ [DefinitionLink $ LocationLink Nothing testFileUri range1 range1]) :|
66+
[ InR . InL $
67+
[ DefinitionLink $ LocationLink Nothing testFileUri range2 range2
68+
, DefinitionLink $ LocationLink Nothing testFileUri range3 range3
69+
]
70+
]
71+
72+
result = combineResponses SMethod_TextDocumentDefinition def supportsLinkInDefinitionCaps definitionParams pluginResponses
73+
74+
expectedResult :: Definition |? ([DefinitionLink] |? Null)
75+
expectedResult = InR . InL $
76+
[ DefinitionLink $ LocationLink Nothing testFileUri range1 range1
77+
, DefinitionLink $ LocationLink Nothing testFileUri range2 range2
78+
, DefinitionLink $ LocationLink Nothing testFileUri range3 range3
79+
]
80+
expectedResult @=? result
81+
82+
, testCase "merges location responses with link responses into link responses (with link support)" $ do
83+
let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null))
84+
pluginResponses =
85+
(InL . Definition . InL . Location testFileUri $ range1) :|
86+
[ InR . InL $ [ DefinitionLink $ LocationLink Nothing testFileUri range2 range2 ]
87+
, InL . Definition . InR $ [Location testFileUri range3]
88+
]
89+
90+
result = combineResponses SMethod_TextDocumentDefinition def supportsLinkInDefinitionCaps definitionParams pluginResponses
91+
92+
expectedResult :: Definition |? ([DefinitionLink] |? Null)
93+
expectedResult = InR . InL $
94+
[ DefinitionLink $ LocationLink Nothing testFileUri range1 range1
95+
, DefinitionLink $ LocationLink Nothing testFileUri range2 range2
96+
, DefinitionLink $ LocationLink Nothing testFileUri range3 range3
97+
]
98+
expectedResult @=? result
99+
100+
, testCase "ignores Null responses when other responses are available" $ do
101+
let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null))
102+
pluginResponses =
103+
(InL . Definition . InL . Location testFileUri $ range1) :|
104+
[ InR . InR $ Null
105+
, InL . Definition . InR $ [Location testFileUri range3]
106+
]
107+
108+
result = combineResponses SMethod_TextDocumentDefinition def supportsLinkInDefinitionCaps definitionParams pluginResponses
109+
110+
expectedResult :: Definition |? ([DefinitionLink] |? Null)
111+
expectedResult = InR . InL $
112+
[ DefinitionLink $ LocationLink Nothing testFileUri range1 range1
113+
, DefinitionLink $ LocationLink Nothing testFileUri range3 range3
114+
]
115+
expectedResult @=? result
116+
117+
, testCase "returns Null when all responses are Null" $ do
118+
let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null))
119+
pluginResponses =
120+
(InR . InR $ Null) :|
121+
[ InR . InR $ Null
122+
, InR . InR $ Null
123+
]
124+
125+
result = combineResponses SMethod_TextDocumentDefinition def supportsLinkInDefinitionCaps definitionParams pluginResponses
126+
127+
expectedResult :: Definition |? ([DefinitionLink] |? Null)
128+
expectedResult = InR . InR $ Null
129+
expectedResult @=? result
130+
]
131+
132+
(range1, range2, range3) = (Range (Position 3 0) $ Position 3 5, Range (Position 5 7) $ Position 5 13, Range (Position 24 30) $ Position 24 40)
133+
134+
supportsLinkInDefinitionCaps :: ClientCapabilities
135+
supportsLinkInDefinitionCaps = def & L.textDocument ?~ textDocumentCaps
136+
where
137+
textDocumentCaps :: TextDocumentClientCapabilities
138+
textDocumentCaps = def { _definition = Just DefinitionClientCapabilities { _linkSupport = Just True, _dynamicRegistration = Nothing }}
139+
140+
definitionParams :: DefinitionParams
141+
definitionParams = DefinitionParams
142+
{ _textDocument = TextDocumentIdentifier testFileUri
143+
, _position = Position 5 4
144+
, _workDoneToken = Nothing
145+
, _partialResultToken = Nothing
146+
}
147+
148+
testFileUri :: Uri
149+
testFileUri = filePathToUri "file://tester/Test.hs"

hls-plugin-api/test/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Main where
22

33
import qualified Ide.PluginUtilsTest as PluginUtilsTest
4+
import qualified Ide.TypesTests as PluginTypesTests
45
import Test.Tasty
56
import Test.Tasty.Ingredients.Rerun
67

@@ -10,4 +11,5 @@ main = defaultMainWithRerun tests
1011
tests :: TestTree
1112
tests = testGroup "Main"
1213
[ PluginUtilsTest.tests
14+
, PluginTypesTests.tests
1315
]

0 commit comments

Comments
 (0)