Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 4c79cba

Browse files
author
Cassandra Comar
committed
Merge remote-tracking branch 'jetjinser/inlay-hints-local-binding' into local-binding-hints
2 parents f162053 + 94c6841 commit 4c79cba

34 files changed

+664
-44
lines changed

‎ghcide-test/exe/InlayHintTests.hs

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
{-# LANGUAGE ExplicitNamespaces #-}
2+
3+
module InlayHintTests (tests) where
4+
5+
import Config (mkIdeTestFs, testWithDummyPlugin,
6+
testWithDummyPluginEmpty)
7+
import Control.Monad (void)
8+
import Control.Monad.IO.Class (MonadIO (liftIO))
9+
import qualified Data.Aeson as A
10+
import Data.Maybe (mapMaybe)
11+
import qualified Data.Text as T
12+
import Language.LSP.Protocol.Types (InlayHint (..),
13+
Position (Position),
14+
Range (Range, _end, _start),
15+
TextDocumentIdentifier (TextDocumentIdentifier),
16+
TextEdit (TextEdit, _newText, _range),
17+
UInt,
18+
VersionedTextDocumentIdentifier (_uri),
19+
type (|?) (..))
20+
import Language.LSP.Test (applyEdit, createDoc,
21+
documentContents, getInlayHints,
22+
openDoc, setConfigSection)
23+
import Test.Hls (Assertion, Session, expectFail,
24+
waitForTypecheck)
25+
import Test.Hls.FileSystem (copyDir)
26+
import Test.Tasty (TestTree, testGroup)
27+
import Test.Tasty.HUnit ((@=?), (@?=))
28+
29+
tests :: TestTree
30+
tests = testGroup "inlay hints"
31+
[ whereInlayHintsTests
32+
]
33+
34+
whereInlayHintsTests :: TestTree
35+
whereInlayHintsTests = testGroup "add signature for where clauses"
36+
[ testWithDummyPluginEmpty "No where inlay hints if disabled" $ do
37+
let content = T.unlines
38+
[ "module Sigs where"
39+
, "f :: b"
40+
, "f = undefined"
41+
, " where"
42+
, " g = True"
43+
]
44+
range = Range { _start = Position 4 0
45+
, _end = Position 4 1000
46+
}
47+
doc <- createDoc "Sigs.hs" "haskell" content
48+
setConfigSection "haskell" (createConfig False)
49+
inlayHints <- getInlayHints doc range
50+
liftIO $ length inlayHints @?= 0
51+
, testGroup "apply EditText"
52+
[ editTest "Simple"
53+
, editTest "Tuple"
54+
, editTest "Inline"
55+
, editTest "Infix"
56+
, editTest "Operator"
57+
, expectFail $ editTest "ScopedTypeVariables"
58+
, editTest "Nest"
59+
, editTest "NoLens"
60+
, expectFail $ editTest "Typeclass"
61+
, editTest "Qualified"
62+
]
63+
, testGroup "apply EditText"
64+
[ hintTest "Simple" $ (@=?)
65+
[defInlayHint { _position = Position 5 9
66+
, _label = InL ":: Bool"
67+
, _textEdits = Just [mkTextEdit 5 8 "g :: Bool\n "]
68+
}]
69+
, hintTest "Tuple" $ (@=?)
70+
[ defInlayHint { _position = Position 5 10
71+
, _label = InL ":: Integer"
72+
, _textEdits = Just [mkTextEdit 5 8 "g :: Integer\n "]
73+
}
74+
, defInlayHint { _position = Position 5 13
75+
, _label = InL ":: Bool"
76+
, _textEdits = Just [mkTextEdit 5 8 "h :: Bool\n "]
77+
}
78+
]
79+
, hintTest "Inline" $ (@=?)
80+
[defInlayHint { _position = Position 4 11
81+
, _label = InL ":: Bool"
82+
, _textEdits = Just [mkTextEdit 4 10 "g :: Bool\n "]
83+
}]
84+
, hintTest "Infix" $ (@=?)
85+
[defInlayHint { _position = Position 5 13
86+
, _label = InL ":: p1 -> p -> p1"
87+
, _textEdits = Just [mkTextEdit 5 8 "g :: p1 -> p -> p1\n "]
88+
}]
89+
, hintTest "Operator" $ (@=?)
90+
[defInlayHint { _position = Position 5 9
91+
, _label = InL ":: (a -> b) -> a -> b"
92+
, _textEdits = Just [mkTextEdit 5 8 "g :: (a -> b) -> a -> b\n "]
93+
}]
94+
, hintTest "Nest" $ (@=?)
95+
[ defInlayHint { _position = Position 6 9
96+
, _label = InL ":: Int"
97+
, _textEdits = Just [mkTextEdit 6 8 "h :: Int\n "]
98+
}
99+
, defInlayHint { _position = Position 5 9
100+
, _label = InL ":: Int"
101+
, _textEdits = Just [mkTextEdit 5 8 "g :: Int\n "]
102+
}
103+
, defInlayHint { _position = Position 6 21
104+
, _label = InL ":: Int"
105+
, _textEdits = Just [mkTextEdit 6 20 "k :: Int\n "]
106+
}
107+
]
108+
, hintTest "NoLens" $ (@=?) []
109+
, hintTest "Qualified" $ (@=?)
110+
[ defInlayHint { _position = Position 7 10
111+
, _label = InL ":: Map.Map Bool Char"
112+
, _textEdits = Just [mkTextEdit 7 9 "g :: Map.Map Bool Char\n "]
113+
}
114+
]
115+
]
116+
]
117+
118+
editTest :: String -> TestTree
119+
editTest file =
120+
testWithDummyPlugin (file <> " (InlayHint EditText)") (mkIdeTestFs [copyDir "local-sig-inlay-hints"]) $ do
121+
doc <- openDoc (file ++ ".hs") "haskell"
122+
executeAllHints doc globalRange
123+
real <- documentContents doc
124+
expectedDoc <- openDoc (file ++ ".expected.hs") "haskell"
125+
expected <- documentContents expectedDoc
126+
liftIO $ real @?= expected
127+
128+
hintTest :: String -> ([InlayHint] -> Assertion) -> TestTree
129+
hintTest file assert =
130+
testWithDummyPlugin (file <> " (InlayHint)") (mkIdeTestFs [copyDir "local-sig-inlay-hints"]) $ do
131+
doc <- openDoc (file ++ ".hs") "haskell"
132+
hints <- getInlayHints doc globalRange
133+
liftIO $ assert hints
134+
135+
136+
createConfig :: Bool -> A.Value
137+
createConfig on =
138+
A.object [ "plugin"
139+
A..= A.object [ "ghcide-type-lenses"
140+
A..= A.object [ "config"
141+
A..= A.object [ "localBindingInlayHintOn" A..= A.Bool on ]]]]
142+
143+
144+
executeAllHints :: TextDocumentIdentifier -> Range -> Session ()
145+
executeAllHints doc range = do
146+
void $ waitForTypecheck doc
147+
hints <- getInlayHints doc range
148+
let edits = concat $ mapMaybe _textEdits hints
149+
case edits of
150+
[] -> pure ()
151+
edit : _ -> do
152+
newDoc <- applyEdit doc edit
153+
executeAllHints (TextDocumentIdentifier $ _uri newDoc) range
154+
155+
defInlayHint :: InlayHint
156+
defInlayHint =
157+
InlayHint { _position = Position 0 0
158+
, _label = InL ""
159+
, _kind = Nothing
160+
, _textEdits = Nothing
161+
, _tooltip = Nothing
162+
, _paddingLeft = Just True
163+
, _paddingRight = Nothing
164+
, _data_ = Nothing
165+
}
166+
167+
mkTextEdit :: UInt -> UInt -> T.Text -> TextEdit
168+
mkTextEdit x y text =
169+
TextEdit { _range = pointRange x y
170+
, _newText = text
171+
}
172+
173+
pointRange :: UInt -> UInt -> Range
174+
pointRange x y = Range (Position x y) (Position x y)
175+
176+
globalRange :: Range
177+
globalRange = Range { _start = Position 0 0
178+
, _end = Position 1000 0
179+
}

‎ghcide-test/exe/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ import HaddockTests
5151
import HighlightTests
5252
import IfaceTests
5353
import InitializeResponseTests
54+
import InlayHintTests
5455
import LogType ()
5556
import NonLspCommandLine
5657
import OpenCloseTest
@@ -103,4 +104,5 @@ main = do
103104
, GarbageCollectionTests.tests
104105
, HieDbRetry.tests
105106
, ExceptionTests.tests
107+
, InlayHintTests.tests
106108
]

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /