@@ -29,7 +29,7 @@ import Control.Applicative.Combinators (skipManyTill)
29
29
import Control.Concurrent.Async (withAsync )
30
30
import Control.Exception.Safe (IOException , handleAny ,
31
31
try )
32
- import Control.Lens ((^.) )
32
+ import Control.Lens (_Just , (&) , (.~) , (^.) )
33
33
import Control.Lens.Extras (is )
34
34
import Control.Monad.Extra (allM , forM , forM_ , forever ,
35
35
unless , void , when ,
@@ -108,6 +108,22 @@ experiments =
108
108
bench " hover" $ allWithIdentifierPos $ \ DocumentPositions {.. } ->
109
109
isJust <$> getHover doc (fromJust identifierP),
110
110
---------------------------------------------------------------------------------------
111
+ bench " hover after edit" $ \ docs -> do
112
+ forM_ docs $ \ DocumentPositions {.. } ->
113
+ changeDoc doc [charEdit stringLiteralP]
114
+ flip allWithIdentifierPos docs $ \ DocumentPositions {.. } ->
115
+ isJust <$> getHover doc (fromJust identifierP),
116
+ ---------------------------------------------------------------------------------------
117
+ bench
118
+ " hover after cradle edit"
119
+ (\ docs -> do
120
+ hieYamlUri <- getDocUri " hie.yaml"
121
+ liftIO $ appendFile (fromJust $ uriToFilePath hieYamlUri) " ##\n "
122
+ sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
123
+ [ FileEvent hieYamlUri FileChangeType_Changed ]
124
+ flip allWithIdentifierPos docs $ \ DocumentPositions {.. } -> isJust <$> getHover doc (fromJust identifierP)
125
+ ),
126
+ ---------------------------------------------------------------------------------------
111
127
bench " edit" $ \ docs -> do
112
128
forM_ docs $ \ DocumentPositions {.. } -> do
113
129
changeDoc doc [charEdit stringLiteralP]
@@ -128,12 +144,6 @@ experiments =
128
144
waitForProgressDone
129
145
return True ,
130
146
---------------------------------------------------------------------------------------
131
- bench " hover after edit" $ \ docs -> do
132
- forM_ docs $ \ DocumentPositions {.. } ->
133
- changeDoc doc [charEdit stringLiteralP]
134
- flip allWithIdentifierPos docs $ \ DocumentPositions {.. } ->
135
- isJust <$> getHover doc (fromJust identifierP),
136
- ---------------------------------------------------------------------------------------
137
147
bench " getDefinition" $ allWithIdentifierPos $ \ DocumentPositions {.. } ->
138
148
hasDefinitions <$> getDefinitions doc (fromJust identifierP),
139
149
---------------------------------------------------------------------------------------
@@ -162,30 +172,21 @@ experiments =
162
172
flip allWithIdentifierPos docs $ \ DocumentPositions {.. } ->
163
173
not . null <$> getCompletions doc (fromJust identifierP),
164
174
---------------------------------------------------------------------------------------
165
- benchWithSetup
175
+ bench
166
176
" code actions"
167
177
( \ docs -> do
168
178
unless (any (isJust . identifierP) docs) $
169
179
error " None of the example modules is suitable for this experiment"
170
- forM_ docs $ \ DocumentPositions {.. } -> do
171
- forM_ identifierP $ \ p -> changeDoc doc [charEdit p]
172
- waitForProgressStart
173
- waitForProgressDone
174
- )
175
- ( \ docs -> not . null . catMaybes <$> forM docs (\ DocumentPositions {.. } ->
176
- forM identifierP $ \ p ->
177
- getCodeActions doc (Range p p))
180
+ not . null . catMaybes <$> forM docs (\ DocumentPositions {.. } -> do
181
+ forM identifierP $ \ p ->
182
+ getCodeActions doc (Range p p))
178
183
),
179
184
---------------------------------------------------------------------------------------
180
- benchWithSetup
185
+ bench
181
186
" code actions after edit"
182
187
( \ docs -> do
183
188
unless (any (isJust . identifierP) docs) $
184
189
error " None of the example modules is suitable for this experiment"
185
- forM_ docs $ \ DocumentPositions {.. } ->
186
- forM_ identifierP $ \ p -> changeDoc doc [charEdit p]
187
- )
188
- ( \ docs -> do
189
190
forM_ docs $ \ DocumentPositions {.. } -> do
190
191
changeDoc doc [charEdit stringLiteralP]
191
192
waitForProgressStart
@@ -195,15 +196,8 @@ experiments =
195
196
getCodeActions doc (Range p p))
196
197
),
197
198
---------------------------------------------------------------------------------------
198
- benchWithSetup
199
+ bench
199
200
" code actions after cradle edit"
200
- ( \ docs -> do
201
- forM_ docs $ \ DocumentPositions {.. } -> do
202
- forM identifierP $ \ p -> do
203
- changeDoc doc [charEdit p]
204
- waitForProgressStart
205
- void waitForBuildQueue
206
- )
207
201
( \ docs -> do
208
202
hieYamlUri <- getDocUri " hie.yaml"
209
203
liftIO $ appendFile (fromJust $ uriToFilePath hieYamlUri) " ##\n "
@@ -219,13 +213,20 @@ experiments =
219
213
),
220
214
---------------------------------------------------------------------------------------
221
215
bench
222
- " hover after cradle edit"
223
- (\ docs -> do
224
- hieYamlUri <- getDocUri " hie.yaml"
225
- liftIO $ appendFile (fromJust $ uriToFilePath hieYamlUri) " ##\n "
226
- sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
227
- [ FileEvent hieYamlUri FileChangeType_Changed ]
228
- flip allWithIdentifierPos docs $ \ DocumentPositions {.. } -> isJust <$> getHover doc (fromJust identifierP)
216
+ " code lens"
217
+ ( \ docs -> not . null <$> forM docs (\ DocumentPositions {.. } ->
218
+ getCodeLenses doc)
219
+ ),
220
+ ---------------------------------------------------------------------------------------
221
+ bench
222
+ " code lens after edit"
223
+ ( \ docs -> do
224
+ forM_ docs $ \ DocumentPositions {.. } -> do
225
+ changeDoc doc [charEdit stringLiteralP]
226
+ waitForProgressStart
227
+ waitForProgressDone
228
+ not . null <$> forM docs (\ DocumentPositions {.. } -> do
229
+ getCodeLenses doc)
229
230
),
230
231
---------------------------------------------------------------------------------------
231
232
benchWithSetup
@@ -483,7 +484,10 @@ runBenchmarksFun dir allBenchmarks = do
483
484
]
484
485
++ [" --ot-memory-profiling" | Just _ <- [otMemoryProfiling ? config]]
485
486
lspTestCaps =
486
- fullCaps {_window = Just $ WindowClientCapabilities (Just True ) Nothing Nothing }
487
+ fullCaps
488
+ & (L. window . _Just) .~ WindowClientCapabilities (Just True ) Nothing Nothing
489
+ & (L. textDocument . _Just . L. codeAction . _Just . L. resolveSupport . _Just) .~ (# properties .== [" edit" ])
490
+ & (L. textDocument . _Just . L. codeAction . _Just . L. dataSupport . _Just) .~ True
487
491
488
492
showMs :: Seconds -> String
489
493
showMs = printf " %.2f"
@@ -512,7 +516,7 @@ waitForProgressStart :: Session ()
512
516
waitForProgressStart = void $ do
513
517
skipManyTill anyMessage $ satisfy $ \ case
514
518
FromServerMess SMethod_WindowWorkDoneProgressCreate _ -> True
515
- _ -> False
519
+ _ -> False
516
520
517
521
-- | Wait for all progress to be done
518
522
-- Needs at least one progress done notification to return
@@ -542,11 +546,9 @@ runBench ::
542
546
(Session BenchRun -> IO BenchRun ) ->
543
547
Bench ->
544
548
IO BenchRun
545
- runBench runSess b = handleAny (\ e -> print e >> return badRun)
549
+ runBench runSess Bench { .. } = handleAny (\ e -> print e >> return badRun)
546
550
$ runSess
547
551
$ do
548
- case b of
549
- Bench {.. } -> do
550
552
(startup, docs) <- duration $ do
551
553
(d, docs) <- duration $ setupDocumentContents ? config
552
554
output $ " Setting up document contents took " <> showDuration d
0 commit comments