Skip to content

Commit 8b6f15e

Browse files
jetjinserjetjinser
committed
Add Inlay Hints payload test for type lens
1 parent e61663d commit 8b6f15e

File tree

1 file changed

+130
-39
lines changed

1 file changed

+130
-39
lines changed

‎ghcide/test/exe/InlayHintTests.hs‎

Lines changed: 130 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE ExplicitNamespaces #-}
2+
13
module InlayHintTests (tests) where
24

35
import Config (mkIdeTestFs, testWithDummyPlugin,
@@ -7,19 +9,22 @@ import Control.Monad.IO.Class (MonadIO (liftIO))
79
import qualified Data.Aeson as A
810
import Data.Maybe (mapMaybe)
911
import qualified Data.Text as T
10-
import Language.LSP.Protocol.Types (InlayHint (_textEdits),
12+
import Language.LSP.Protocol.Types (InlayHint (..),
1113
Position (Position),
1214
Range (Range, _end, _start),
1315
TextDocumentIdentifier (TextDocumentIdentifier),
14-
VersionedTextDocumentIdentifier (_uri))
16+
TextEdit (TextEdit, _newText, _range),
17+
UInt,
18+
VersionedTextDocumentIdentifier (_uri),
19+
type (|?) (..))
1520
import Language.LSP.Test (applyEdit, createDoc,
1621
documentContents, getInlayHints,
1722
openDoc, setConfigSection)
18-
import Test.Hls (Session, expectFail,
23+
import Test.Hls (Assertion, Session, expectFail,
1924
waitForTypecheck)
2025
import Test.Hls.FileSystem (copyDir)
2126
import Test.Tasty (TestTree, testGroup)
22-
import Test.Tasty.HUnit ((@?=))
27+
import Test.Tasty.HUnit ((@=?), (@?=))
2328

2429
tests :: TestTree
2530
tests = testGroup "inlay hints"
@@ -43,44 +48,130 @@ whereInlayHintsTests = testGroup "add signature for where clauses"
4348
setConfigSection "haskell" (createConfig False)
4449
inlayHints <- getInlayHints doc range
4550
liftIO $ length inlayHints @?= 0
46-
, editTest "Simple" "Simple"
47-
, editTest "Tuple" "Tuple"
48-
, editTest "Inline" "Inline"
49-
, editTest "Infix" "Infix"
50-
, editTest "Operator" "Operator"
51-
, expectFail $ editTest "ScopedTypeVariables" "ScopedTypeVariables"
52-
, editTest "Nest" "Nest"
53-
, editTest "No lens" "NoLens"
54-
, expectFail $ editTest "Typeclass" "Typeclass"
55-
, editTest "Quqlified" "Qualified"
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+
]
56116
]
57-
where
58-
createConfig on =
59-
A.object [ "plugin"
60-
A..= A.object [ "ghcide-type-lenses"
61-
A..= A.object [ "config"
62-
A..= A.object [ "whereInlayHintOn" A..= A.Bool on ]]]]
63117

64-
editTest title file =
65-
testWithDummyPlugin title (mkIdeTestFs [copyDir "local-sig-lens"]) $ do
66-
doc <- openDoc (file ++ ".hs") "haskell"
67-
executeAllHints doc globalRange
68-
real <- documentContents doc
69-
expectedDoc <- openDoc (file ++ ".expected.hs") "haskell"
70-
expected <- documentContents expectedDoc
71-
liftIO $ real @?= expected
118+
editTest :: String -> TestTree
119+
editTest file =
120+
testWithDummyPlugin (file <> " (InlayHint EditText)") (mkIdeTestFs [copyDir "local-sig-lens"]) $ 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-lens"]) $ 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 [ "whereInlayHintOn" 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+
}
72172

73-
executeAllHints :: TextDocumentIdentifier -> Range -> Session ()
74-
executeAllHints doc range = do
75-
void $ waitForTypecheck doc
76-
hints <- getInlayHints doc range
77-
let edits = concat $ mapMaybe _textEdits hints
78-
case edits of
79-
[] -> pure ()
80-
edit : _ -> do
81-
newDoc <- applyEdit doc edit
82-
-- pure ()
83-
executeAllHints (TextDocumentIdentifier $ _uri newDoc) range
173+
pointRange :: UInt -> UInt -> Range
174+
pointRange x y = Range (Position x y) (Position x y)
84175

85176
globalRange :: Range
86177
globalRange = Range { _start = Position 0 0

0 commit comments

Comments
 (0)