Skip to content

Commit 62fbccf

Browse files
committed
WIP: add basic tests
1 parent 622c8ec commit 62fbccf

File tree

3 files changed

+229
-11
lines changed

3 files changed

+229
-11
lines changed

.github/workflows/test.yml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -261,6 +261,10 @@ jobs:
261261
name: Compile the plugin-tutorial
262262
run: cabal build plugin-tutorial
263263

264+
- if: matrix.test
265+
name: Test hls-signature-help-plugin test suite
266+
run: cabal test hls-signature-help-plugin-tests || cabal test hls-signature-help-plugin-tests
267+
264268
test_post_job:
265269
if: always()
266270
runs-on: ubuntu-latest

haskell-language-server.cabal

Lines changed: 16 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -868,17 +868,22 @@ library hls-signature-help-plugin
868868
, text
869869

870870

871-
-- test-suite hls-signature-help-plugin-tests
872-
-- import: defaults, pedantic, test-defaults, warnings
873-
-- if !flag(signatureHelp)
874-
-- buildable: False
875-
-- type: exitcode-stdio-1.0
876-
-- hs-source-dirs: plugins/hls-signature-help-plugin/test
877-
-- main-is: Main.hs
878-
-- build-depends:
879-
-- , haskell-language-server:hls-signature-help-plugin
880-
-- , hls-test-utils == 2.11.0.0
881-
-- , hls-plugin-api == 2.11.0.0
871+
test-suite hls-signature-help-plugin-tests
872+
import: defaults, pedantic, test-defaults, warnings
873+
if !flag(signatureHelp)
874+
buildable: False
875+
type: exitcode-stdio-1.0
876+
hs-source-dirs: plugins/hls-signature-help-plugin/test
877+
main-is: Main.hs
878+
build-depends:
879+
, ghcide
880+
, haskell-language-server:hls-signature-help-plugin
881+
, hls-test-utils == 2.11.0.0
882+
, lens
883+
, lsp-types
884+
, text
885+
default-extensions:
886+
OverloadedStrings
882887

883888
-----------------------------
884889
-- module name plugin
Lines changed: 209 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,209 @@
1+
{-# LANGUAGE QuasiQuotes #-}
2+
3+
import Control.Exception (throw)
4+
import Control.Lens ((^.))
5+
import Data.Maybe (fromJust)
6+
import Data.Text (Text)
7+
import qualified Data.Text as T
8+
import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (PosPrefixInfo))
9+
import Ide.Plugin.SignatureHelp (descriptor)
10+
import qualified Language.LSP.Protocol.Lens as L
11+
import Test.Hls
12+
import Test.Hls.FileSystem (VirtualFileTree,
13+
directCradle, file,
14+
mkVirtualFileTree,
15+
text)
16+
17+
18+
main :: IO ()
19+
main =
20+
defaultTestRunner $
21+
testGroup
22+
"signatureHelp"
23+
[ mkTest
24+
"1 parameter"
25+
[trimming|
26+
f :: Int -> Int
27+
f = _
28+
x = f 1
29+
^^^^^^^^
30+
|]
31+
[ Nothing,
32+
Nothing,
33+
Nothing,
34+
Nothing,
35+
Nothing,
36+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), -- TODO(@linj) or Nothing?
37+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
38+
Nothing -- TODO(@linj) or highlight the last parameter?
39+
],
40+
mkTest
41+
"2 parameters"
42+
[trimming|
43+
f :: Int -> Int -> Int
44+
f = _
45+
x = f 1 2
46+
^ ^^^
47+
|]
48+
[ Nothing,
49+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
50+
Nothing, -- TODO(@linj) or highligt the first/second parameter?
51+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1))
52+
],
53+
mkTest
54+
"3 parameters"
55+
[trimming|
56+
f :: Int -> Int -> Int -> Int
57+
f = _
58+
x = f 1 2 3
59+
^ ^ ^ ^
60+
|]
61+
[ Nothing,
62+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
63+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)),
64+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 2))] (Just 0) (Just (InL 2))
65+
],
66+
mkTest
67+
"parentheses"
68+
[trimming|
69+
f :: Int -> Int -> Int
70+
f = _
71+
x = (f 1) 2
72+
^^ ^^^^
73+
|]
74+
[ Nothing,
75+
Nothing,
76+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
77+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
78+
Nothing, -- TODO(@linj) or the first/second parameter of f
79+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1))
80+
],
81+
mkTest
82+
"newline"
83+
[trimming|
84+
f :: Int -> Int -> Int
85+
f = _
86+
x =
87+
(
88+
^
89+
f
90+
^
91+
1
92+
^
93+
)
94+
^
95+
2
96+
^
97+
98+
^
99+
|]
100+
[ Nothing,
101+
Nothing,
102+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
103+
Nothing,
104+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)),
105+
Nothing
106+
],
107+
mkTest
108+
"nested"
109+
[trimming|
110+
f :: Int -> Int -> Int
111+
f = _
112+
g :: Int -> Int
113+
g = _
114+
x = f (g 1) 2
115+
^^^^ ^^^^
116+
|]
117+
[ Nothing,
118+
Nothing,
119+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
120+
Nothing,
121+
Just $ SignatureHelp [SignatureInformation "g :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
122+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
123+
Nothing, -- TODO(@linj) or the first/second parameter of f
124+
Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1))
125+
],
126+
mkTest
127+
"type constraint"
128+
[trimming|
129+
f :: (Num a) => a -> a -> a
130+
f = _
131+
x = f 1 2
132+
^ ^ ^
133+
|]
134+
[ Nothing,
135+
Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)),
136+
Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1))
137+
],
138+
mkTest
139+
"dynamic function"
140+
[trimming|
141+
f :: Int -> Int -> Int
142+
f = _
143+
g :: Int -> Int -> Int
144+
g = _
145+
x = (if _ then f else g) 1 2
146+
^^ ^^^ ^ ^^^ ^ ^^^^^^^^
147+
|]
148+
(replicate 18 Nothing),
149+
mkTest
150+
"multi-line type"
151+
[trimming|
152+
f :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
153+
f = _
154+
x = f 1
155+
^ ^
156+
|]
157+
[ Nothing,
158+
Just $ SignatureHelp [SignatureInformation "f :: Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists
159+
],
160+
mkTest
161+
"multi-line type with type constraint"
162+
[trimming|
163+
f :: Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn
164+
f = _
165+
x = f 1
166+
^ ^
167+
|]
168+
[ Nothing,
169+
Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn.\nNum abcdefghijklmn =>\nabcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists
170+
]
171+
]
172+
173+
mkTest :: TestName -> Text -> [Maybe SignatureHelp] -> TestTree
174+
mkTest name sourceCode expectedSignatureHelps =
175+
parameterisedCursorTest
176+
name
177+
sourceCode
178+
expectedSignatureHelps
179+
getSignatureHelpFromSession
180+
181+
getSignatureHelpFromSession :: Text -> PosPrefixInfo -> IO (Maybe SignatureHelp)
182+
getSignatureHelpFromSession sourceCode (PosPrefixInfo _ _ _ position) =
183+
let fileName = "A.hs"
184+
plugin = mkPluginTestDescriptor descriptor "signatureHelp"
185+
virtualFileTree = mkVirtualFileTreeWithSingleFile fileName sourceCode
186+
in runSessionWithServerInTmpDir def plugin virtualFileTree $ do
187+
doc <- openDoc fileName "haskell"
188+
getSignatureHelp doc position
189+
190+
mkVirtualFileTreeWithSingleFile :: FilePath -> Text -> VirtualFileTree
191+
mkVirtualFileTreeWithSingleFile fileName sourceCode =
192+
let testDataDir = "/not-used-dir"
193+
in mkVirtualFileTree
194+
testDataDir
195+
[ directCradle [T.pack fileName],
196+
file fileName (text sourceCode)
197+
]
198+
199+
-- TODO(@linj) upstream it to lsp-test
200+
-- | Returns the signature help at the specified position.
201+
getSignatureHelp :: TextDocumentIdentifier -> Position -> Session (Maybe SignatureHelp)
202+
getSignatureHelp doc pos =
203+
let params = SignatureHelpParams doc pos Nothing Nothing
204+
in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentSignatureHelp params
205+
where
206+
getResponseResult rsp =
207+
case rsp ^. L.result of
208+
Right x -> x
209+
Left err -> throw $ UnexpectedResponseError (fromJust $ rsp ^. L.id) err

0 commit comments

Comments
 (0)