@@ -1,287 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE ExistentialQuantification #-}
3−{-# LANGUAGE ImplicitParams #-}
4−
5−{- An automated benchmark built around the simple experiment described in:
6−
7− > https://neilmitchell.blogspot.com/2020/05/fixing-space-leaks-in-ghcide.html
8−
9− As an example project, it unpacks Cabal-3.2.0.0 in the local filesystem and
10− loads the module 'Distribution.Simple'. The rationale for this choice is:
11−
12− - It's convenient to download with `cabal unpack Cabal-3.2.0.0`
13− - It has very few dependencies, and all are already needed to build ghcide
14− - Distribution.Simple has 235 transitive module dependencies, so non trivial
15−
16− The experiments are sequences of lsp commands scripted using lsp-test.
17− A more refined approach would be to record and replay real IDE interactions,
18− once the replay functionality is available in lsp-test.
19− A more declarative approach would be to reuse ide-debug-driver:
20−
21− > https://github.com/digital-asset/daml/blob/master/compiler/damlc/ide-debug-driver/README.md
22−
23− The result of an experiment is a total duration in seconds after a preset
24− number of iterations. There is ample room for improvement:
25− - Statistical analysis to detect outliers and auto infer the number of iterations needed
26− - GC stats analysis (currently -S is printed as part of the experiment)
27− - Analyisis of performance over the commit history of the project
28−
29− How to run:
30− 1. `cabal bench`
31− 2. `cabal exec <absolute-path-to-ghcide-bench> -- ghcide-bench-options`
32−
33− Note that the package database influences the response times of certain actions,
34− e.g. code actions, and therefore the two methods above do not necessarily
35− produce the same results.
36−
37− -}
38−
39−import Control.Applicative.Combinators
40−import Control.Concurrent
41−import Control.Exception.Safe
42−import Control.Monad.Extra
43−import Control.Monad.IO.Class
44−import Data.Aeson
45−import Data.List
46−import Data.Maybe
47−import Data.Version
48−import Language.Haskell.LSP.Test
49−import Language.Haskell.LSP.Types
50−import Language.Haskell.LSP.Types.Capabilities
51−import Numeric.Natural
52−import Options.Applicative
53−import System.Directory
54−import System.FilePath ((</>))
55−import System.Process
56−import System.Time.Extra
57−
58−-- Points to a string in the target file,
59−-- convenient for hygienic edits
60−hygienicP :: Position
61−hygienicP = Position 854 23
62−
63−-- Points to the middle of an identifier,
64−-- convenient for requesting goto-def, hover and completions
65−identifierP :: Position
66−identifierP = Position 853 12
67−
68−main :: IO ()
69−main = do
70− config <- execParser $ info configP fullDesc
71− let ?config = config
72−
73− output "starting test"
74−
75− cleanUp <- setup
76−
77− runBenchmarks
78− [ ---------------------------------------------------------------------------------------
79− bench "hover" 10 $ \doc ->
80− isJust <$> getHover doc identifierP,
81− ---------------------------------------------------------------------------------------
82− bench "getDefinition" 10 $ \doc ->
83− not . null <$> getDefinitions doc identifierP,
84− ---------------------------------------------------------------------------------------
85− bench "documentSymbols" 100 $
86− fmap (either (not . null) (not . null)) . getDocumentSymbols,
87− ---------------------------------------------------------------------------------------
88− bench "documentSymbols after edit" 100 $ \doc -> do
89− let change =
90− TextDocumentContentChangeEvent
91− { _range = Just (Range hygienicP hygienicP),
92− _rangeLength = Nothing,
93− _text = " "
94− }
95− changeDoc doc [change]
96− either (not . null) (not . null) <$> getDocumentSymbols doc,
97− ---------------------------------------------------------------------------------------
98− bench "completions after edit" 10 $ \doc -> do
99− let change =
100− TextDocumentContentChangeEvent
101− { _range = Just (Range hygienicP hygienicP),
102− _rangeLength = Nothing,
103− _text = " "
104− }
105− changeDoc doc [change]
106− not . null <$> getCompletions doc identifierP,
107− ---------------------------------------------------------------------------------------
108− benchWithSetup
109− "code actions"
110− 10
111− ( \doc -> do
112− let p = identifierP
113− let change =
114− TextDocumentContentChangeEvent
115− { _range = Just (Range p p),
116− _rangeLength = Nothing,
117− _text = "a"
118− }
119− changeDoc doc [change]
120− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
121− return p
122− )
123− ( \p doc -> do
124− not . null <$> getCodeActions doc (Range p p)
125− ),
126− ---------------------------------------------------------------------------------------
127− bench "code actions after edit" 10 $ \doc -> do
128− let p = identifierP
129− let change =
130− TextDocumentContentChangeEvent
131− { _range = Just (Range p p),
132− _rangeLength = Nothing,
133− _text = "a"
134− }
135− changeDoc doc [change]
136− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
137− not . null <$> getCodeActions doc (Range p p)
138− ]
139− `finally` cleanUp
140−
141−---------------------------------------------------------------------------------------------
142−
143−examplePackageName :: String
144−examplePackageName = "Cabal"
145−
146−examplePackageVersion :: Version
147−examplePackageVersion = makeVersion [3, 2, 0, 0]
148−
149−examplePackage :: String
150−examplePackage = examplePackageName <> "-" <> showVersion examplePackageVersion
151−
152−exampleModulePath :: FilePath
153−exampleModulePath = "Distribution" </> "Simple.hs"
154−
155−examplesPath :: FilePath
156−examplesPath = "bench/example"
157−
158−data Config = Config
159− { verbose :: !Bool,
160− -- For some reason, the Shake profile files are truncated and won't load
161− shakeProfiling :: !(Maybe FilePath),
162− outputCSV :: !Bool
163− }
164−
165−type HasConfig = (?config :: Config)
166−
167−configP :: Parser Config
168−configP = Config
169− <$> (not <$> switch (long "quiet"))
170− <*> optional (strOption (long "shake-profiling" <> metavar "PATH"))
171− <*> switch (long "csv")
172−
173−output :: (MonadIO m, HasConfig) => String -> m ()
174−output = if verbose ?config then liftIO . putStrLn else (\_ -> pure ())
175−
176−---------------------------------------------------------------------------------------
177−
178−type Experiment = TextDocumentIdentifier -> Session Bool
179−
180−data Bench = forall setup.
181− Bench
182− { name :: !String,
183− samples :: !Natural,
184− benchSetup :: TextDocumentIdentifier -> Session setup,
185− experiment :: setup -> Experiment
186− }
187−
188−bench :: String -> Natural -> Experiment -> Bench
189−bench name samples userExperiment = Bench {..}
190− where
191− experiment () = userExperiment
192− benchSetup _ = return ()
193−
194−benchWithSetup ::
195− String ->
196− Natural ->
197− (TextDocumentIdentifier -> Session p) ->
198− (p -> Experiment) ->
199− Bench
200−benchWithSetup = Bench
201−
202−runBenchmarks :: HasConfig => [Bench] -> IO ()
203−runBenchmarks benchmarks = do
204− results <- forM benchmarks $ \b -> (b,) <$> runBench b
205−
206− forM_ results $ \(Bench {name, samples}, duration) ->
207− output $
208− "TOTAL "
209− <> name
210− <> " = "
211− <> showDuration duration
212− <> " ("
213− <> show samples
214− <> " repetitions)"
215−
216− when (outputCSV ?config) $ do
217− putStrLn $ intercalate ", " $ map name benchmarks
218− putStrLn $ intercalate ", " $ map (showDuration . snd) results
219−
220−runBench :: HasConfig => Bench -> IO Seconds
221−runBench Bench {..} = handleAny (\e -> print e >> return (-1))
222− $ runSessionWithConfig conf cmd lspTestCaps dir
223− $ do
224− doc <- openDoc exampleModulePath "haskell"
225− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
226−
227− liftIO $ output $ "Running " <> name <> " benchmark"
228− userState <- benchSetup doc
229− let loop 0 = return True
230− loop n = do
231− (t, res) <- duration $ experiment userState doc
232− if not res
233− then return False
234− else do
235− output (showDuration t)
236− loop (n -1)
237−
238− (t, res) <- duration $ loop samples
239−
240− exitServer
241− -- sleeep to give ghcide a chance to print the RTS stats
242− liftIO $ threadDelay 50000
243−
244− return $ if res then t else -1
245− where
246− cmd =
247− unwords $
248− [ "ghcide",
249− "--lsp",
250− "--cwd",
251− dir,
252− "+RTS",
253− "-S",
254− "-RTS"
255− ]
256− ++ concat
257− [ ["--shake-profiling", path]
258− | Just path <- [shakeProfiling ?config]
259− ]
260− dir = "bench/example/" <> examplePackage
261− lspTestCaps =
262− fullCaps {_window = Just $ WindowClientCapabilities $ Just True}
263− conf =
264− defaultConfig
265− { logStdErr = verbose ?config,
266− logMessages = False,
267− logColor = False
268− }
269−
270−setup :: HasConfig => IO (IO ())
271−setup = do
272− alreadyExists <- doesDirectoryExist examplesPath
273− when alreadyExists $ removeDirectoryRecursive examplesPath
274− callCommand $ "cabal get -v0 " <> examplePackage <> " -d " <> examplesPath
275− writeFile
276− (examplesPath </> examplePackage </> "hie.yaml")
277− ("cradle: {cabal: {component: " <> show examplePackageName <> "}}")
278−
279− whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True
280−
281− return $ removeDirectoryRecursive examplesPath
282−
283−-- | Asks the server to shutdown and exit politely
284−exitServer :: Session ()
285−exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
286−
287−--------------------------------------------------------------------------------------------