1
1
{-# LANGUAGE DataKinds #-}
2
+ {-# LANGUAGE DuplicateRecordFields #-}
2
3
{-# LANGUAGE GADTs #-}
4
+ {-# LANGUAGE OverloadedLabels #-}
3
5
{-# LANGUAGE OverloadedStrings #-}
4
6
{-# LANGUAGE ViewPatterns #-}
5
7
@@ -13,11 +15,13 @@ import Control.Lens hiding (Iso, List)
13
15
import Control.Monad
14
16
import Control.Monad.IO.Class
15
17
import Data.Aeson qualified as J
18
+ import Data.Generics.Labels ()
19
+ import Data.Generics.Product.Fields (field' )
16
20
import Data.Maybe
17
21
import Data.Proxy
18
22
import Data.Set qualified as Set
19
- import Language.LSP.Protocol.Lens qualified as L
20
- import Language.LSP.Protocol.Message
23
+ import Language.LSP.Protocol.Lens
24
+ import Language.LSP.Protocol.Message hiding ( error )
21
25
import Language.LSP.Protocol.Types
22
26
import Language.LSP.Server
23
27
import Language.LSP.Test qualified as Test
@@ -85,33 +89,33 @@ spec = do
85
89
-- has happened and the server has been able to send us a begin message
86
90
skipManyTill Test. anyMessage $ do
87
91
x <- Test. message SMethod_Progress
88
- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
92
+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
89
93
90
94
-- allow the hander to send us updates
91
95
putMVar startBarrier ()
92
96
93
97
do
94
98
u <- Test. message SMethod_Progress
95
99
liftIO $ do
96
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step1" )
97
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 25 )
100
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step1" )
101
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 25 )
98
102
99
103
do
100
104
u <- Test. message SMethod_Progress
101
105
liftIO $ do
102
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step2" )
103
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 50 )
106
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step2" )
107
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 50 )
104
108
105
109
do
106
110
u <- Test. message SMethod_Progress
107
111
liftIO $ do
108
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step3" )
109
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 75 )
112
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step3" )
113
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 75 )
110
114
111
115
-- Then make sure we get a $/progress end notification
112
116
skipManyTill Test. anyMessage $ do
113
117
x <- Test. message SMethod_Progress
114
- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
118
+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
115
119
116
120
it " handles cancellation" $ do
117
121
wasCancelled <- newMVar False
@@ -142,19 +146,19 @@ spec = do
142
146
-- Wait until we have created the progress so the updates will be sent individually
143
147
token <- skipManyTill Test. anyMessage $ do
144
148
x <- Test. message SMethod_WindowWorkDoneProgressCreate
145
- pure $ x ^. L. params . L. token
149
+ pure $ x ^. field' @ " params" . # token
146
150
147
151
-- First make sure that we get a $/progress begin notification
148
152
skipManyTill Test. anyMessage $ do
149
153
x <- Test. message SMethod_Progress
150
- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
154
+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
151
155
152
156
Test. sendNotification SMethod_WindowWorkDoneProgressCancel (WorkDoneProgressCancelParams token)
153
157
154
158
-- Then make sure we still get a $/progress end notification
155
159
skipManyTill Test. anyMessage $ do
156
160
x <- Test. message SMethod_Progress
157
- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
161
+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
158
162
159
163
c <- readMVar wasCancelled
160
164
c `shouldBe` True
@@ -186,15 +190,15 @@ spec = do
186
190
-- First make sure that we get a $/progress begin notification
187
191
skipManyTill Test. anyMessage $ do
188
192
x <- Test. message SMethod_Progress
189
- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
193
+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
190
194
191
195
-- Then kill the thread
192
196
liftIO $ putMVar killVar ()
193
197
194
198
-- Then make sure we still get a $/progress end notification
195
199
skipManyTill Test. anyMessage $ do
196
200
x <- Test. message SMethod_Progress
197
- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
201
+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
198
202
199
203
describe " client-initiated progress reporting" $ do
200
204
it " sends updates" $ do
@@ -213,7 +217,7 @@ spec = do
213
217
handlers :: Handlers (LspM () )
214
218
handlers =
215
219
requestHandler SMethod_TextDocumentCodeLens $ \ req resp -> void $ forkIO $ do
216
- withProgress " Doing something" (req ^. L. params . L. workDoneToken) NotCancellable $ \ updater -> do
220
+ withProgress " Doing something" (req ^. field' @ " params" . # workDoneToken) NotCancellable $ \ updater -> do
217
221
updater $ ProgressAmount (Just 25 ) (Just " step1" )
218
222
updater $ ProgressAmount (Just 50 ) (Just " step2" )
219
223
updater $ ProgressAmount (Just 75 ) (Just " step3" )
@@ -224,30 +228,30 @@ spec = do
224
228
-- First make sure that we get a $/progress begin notification
225
229
skipManyTill Test. anyMessage $ do
226
230
x <- Test. message SMethod_Progress
227
- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
231
+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
228
232
229
233
do
230
234
u <- Test. message SMethod_Progress
231
235
liftIO $ do
232
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step1" )
233
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 25 )
236
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step1" )
237
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 25 )
234
238
235
239
do
236
240
u <- Test. message SMethod_Progress
237
241
liftIO $ do
238
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step2" )
239
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 50 )
242
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step2" )
243
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 50 )
240
244
241
245
do
242
246
u <- Test. message SMethod_Progress
243
247
liftIO $ do
244
- u ^? L. params . L. value . _workDoneProgressReport . L. message `shouldBe` Just (Just " step3" )
245
- u ^? L. params . L. value . _workDoneProgressReport . L. percentage `shouldBe` Just (Just 75 )
248
+ u ^? field' @ " params" . # value . workDoneProgressReport . # message `shouldBe` Just (Just " step3" )
249
+ u ^? field' @ " params" . # value . workDoneProgressReport . # percentage `shouldBe` Just (Just 75 )
246
250
247
251
-- Then make sure we get a $/progress end notification
248
252
skipManyTill Test. anyMessage $ do
249
253
x <- Test. message SMethod_Progress
250
- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
254
+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
251
255
252
256
describe " workspace folders" $
253
257
it " keeps track of open workspace folders" $ do
0 commit comments