Skip to content

Commit 463025b

Browse files
committed
Switch to normal field selectors and generic-lens
This adopts the approach discussed here: #465 (comment) That is: - We export normal, non-prefixed record selectors (still using `DuplicateRecordFields`, of course). - Users who want lenses can use `generic-lens`; `lsp` and `lsp-test` do this. - It's sensible for `lsp-types` to define some useful lenses that aren't derived from fields; these go in a `lsp-types-lens` component. I think the result is... fine? kcsongor/generic-lens#96 is a pain in some cases, but by and large using the generic lenses is quite nice. I also tried to just use `OverloadedRecordDot` instead of lenses where I could, since we now support 9.2 as our earliest version. I couldn't quite get rid of `lens` in `lsp`, it's too useful. I did get rid of it entirely in `lsp-types`, which was quite painful in at least one place. This would obviously be a huge breaking change, but I think it's the right direction.
1 parent 7a87841 commit 463025b

File tree

401 files changed

+1890
-1942
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

401 files changed

+1890
-1942
lines changed

lsp-test/bench/SimpleBench.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -62,10 +62,10 @@ main = do
6262
replicateM_ n $ do
6363
v <- liftIO $ readIORef i
6464
liftIO $ when (v `mod` 1000 == 0) $ putStrLn $ show v
65-
TResponseMessage{_result = Right (InL _)} <-
65+
TResponseMessage{result = Right (InL _)} <-
6666
Test.request SMethod_TextDocumentHover $
6767
HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing
68-
TResponseMessage{_result = Right (InL _)} <-
68+
TResponseMessage{result = Right (InL _)} <-
6969
Test.request SMethod_TextDocumentDefinition $
7070
DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing
7171

lsp-test/func-test/FuncTest.hs

+28-24
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
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)
1315
import Control.Monad
1416
import Control.Monad.IO.Class
1517
import Data.Aeson qualified as J
18+
import Data.Generics.Labels ()
19+
import Data.Generics.Product.Fields (field')
1620
import Data.Maybe
1721
import Data.Proxy
1822
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)
2125
import Language.LSP.Protocol.Types
2226
import Language.LSP.Server
2327
import 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

lsp-test/lsp-test.cabal

+7-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
cabal-version: 2.4
1+
cabal-version: 3.0
22
name: lsp-test
33
version: 0.17.0.0
44
synopsis: Functional test framework for LSP servers.
@@ -58,11 +58,13 @@ library
5858
, exceptions ^>=0.10
5959
, extra ^>=1.7
6060
, filepath >=1.4 && < 1.6
61+
, generic-lens ^>=2.2
6162
, Glob >=0.9 && <0.11
6263
, lens >=5.1 && <5.3
6364
, lens-aeson ^>=1.2
6465
, lsp ^>=2.4
65-
, lsp-types ^>=2.1
66+
, lsp-types
67+
, lsp-types:lsp-types-lens
6668
, mtl >=2.2 && <2.4
6769
, parser-combinators ^>=1.3
6870
, process ^>=1.6
@@ -104,6 +106,7 @@ test-suite tests
104106
, directory
105107
, extra
106108
, filepath
109+
, generic-lens
107110
, hspec
108111
, lens
109112
, lsp
@@ -124,10 +127,12 @@ test-suite func-test
124127
, aeson
125128
, co-log-core
126129
, containers
130+
, generic-lens
127131
, hspec
128132
, lens
129133
, lsp
130134
, lsp-test
135+
, lsp-types:lsp-types-lens
131136
, parser-combinators
132137
, process
133138
, unliftio

0 commit comments

Comments
 (0)