11{-# LANGUAGE DataKinds #-}
2+ {-# LANGUAGE DuplicateRecordFields #-}
23{-# LANGUAGE GADTs #-}
4+ {-# LANGUAGE OverloadedLabels #-}
35{-# LANGUAGE OverloadedStrings #-}
46{-# LANGUAGE ViewPatterns #-}
57
@@ -13,11 +15,13 @@ import Control.Lens hiding (Iso, List)
1315import Control.Monad
1416import Control.Monad.IO.Class
1517import Data.Aeson qualified as J
18+ import Data.Generics.Labels ()
19+ import Data.Generics.Product.Fields (field' )
1620import Data.Maybe
1721import Data.Proxy
1822import 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 )
2125import Language.LSP.Protocol.Types
2226import Language.LSP.Server
2327import Language.LSP.Test qualified as Test
@@ -85,33 +89,33 @@ spec = do
8589 -- has happened and the server has been able to send us a begin message
8690 skipManyTill Test. anyMessage $ do
8791 x <- Test. message SMethod_Progress
88- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
92+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
8993
9094 -- allow the hander to send us updates
9195 putMVar startBarrier ()
9296
9397 do
9498 u <- Test. message SMethod_Progress
9599 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 )
98102
99103 do
100104 u <- Test. message SMethod_Progress
101105 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 )
104108
105109 do
106110 u <- Test. message SMethod_Progress
107111 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 )
110114
111115 -- Then make sure we get a $/progress end notification
112116 skipManyTill Test. anyMessage $ do
113117 x <- Test. message SMethod_Progress
114- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
118+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
115119
116120 it " handles cancellation" $ do
117121 wasCancelled <- newMVar False
@@ -142,19 +146,19 @@ spec = do
142146 -- Wait until we have created the progress so the updates will be sent individually
143147 token <- skipManyTill Test. anyMessage $ do
144148 x <- Test. message SMethod_WindowWorkDoneProgressCreate
145- pure $ x ^. L. params . L. token
149+ pure $ x ^. field' @ " params" . # token
146150
147151 -- First make sure that we get a $/progress begin notification
148152 skipManyTill Test. anyMessage $ do
149153 x <- Test. message SMethod_Progress
150- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
154+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
151155
152156 Test. sendNotification SMethod_WindowWorkDoneProgressCancel (WorkDoneProgressCancelParams token)
153157
154158 -- Then make sure we still get a $/progress end notification
155159 skipManyTill Test. anyMessage $ do
156160 x <- Test. message SMethod_Progress
157- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
161+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
158162
159163 c <- readMVar wasCancelled
160164 c `shouldBe` True
@@ -186,15 +190,15 @@ spec = do
186190 -- First make sure that we get a $/progress begin notification
187191 skipManyTill Test. anyMessage $ do
188192 x <- Test. message SMethod_Progress
189- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
193+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
190194
191195 -- Then kill the thread
192196 liftIO $ putMVar killVar ()
193197
194198 -- Then make sure we still get a $/progress end notification
195199 skipManyTill Test. anyMessage $ do
196200 x <- Test. message SMethod_Progress
197- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
201+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
198202
199203 describe " client-initiated progress reporting" $ do
200204 it " sends updates" $ do
@@ -213,7 +217,7 @@ spec = do
213217 handlers :: Handlers (LspM () )
214218 handlers =
215219 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
217221 updater $ ProgressAmount (Just 25 ) (Just " step1" )
218222 updater $ ProgressAmount (Just 50 ) (Just " step2" )
219223 updater $ ProgressAmount (Just 75 ) (Just " step3" )
@@ -224,30 +228,30 @@ spec = do
224228 -- First make sure that we get a $/progress begin notification
225229 skipManyTill Test. anyMessage $ do
226230 x <- Test. message SMethod_Progress
227- guard $ has (L. params . L. value . _workDoneProgressBegin ) x
231+ guard $ has (field' @ " params" . # value . workDoneProgressBegin ) x
228232
229233 do
230234 u <- Test. message SMethod_Progress
231235 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 )
234238
235239 do
236240 u <- Test. message SMethod_Progress
237241 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 )
240244
241245 do
242246 u <- Test. message SMethod_Progress
243247 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 )
246250
247251 -- Then make sure we get a $/progress end notification
248252 skipManyTill Test. anyMessage $ do
249253 x <- Test. message SMethod_Progress
250- guard $ has (L. params . L. value . _workDoneProgressEnd ) x
254+ guard $ has (field' @ " params" . # value . workDoneProgressEnd ) x
251255
252256 describe " workspace folders" $
253257 it " keeps track of open workspace folders" $ do
0 commit comments