@@ -1,287 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE ExistentialQuantification #-}
3−{-# LANGUAGE ImplicitParams #-}
5−{- An automated benchmark built around the simple experiment described in:
7− > https://neilmitchell.blogspot.com/2020/05/fixing-space-leaks-in-ghcide.html
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:
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
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:
21− > https://github.com/digital-asset/daml/blob/master/compiler/damlc/ide-debug-driver/README.md
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
31− 2. `cabal exec <absolute-path-to-ghcide-bench> -- ghcide-bench-options`
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.
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
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 ((</>))
56−import System.Time.Extra
58−-- Points to a string in the target file,
59−-- convenient for hygienic edits
61−hygienicP = Position 854 23
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
70− config <- execParser $ info configP fullDesc
73− output "starting test"
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
90− TextDocumentContentChangeEvent
91− { _range = Just (Range hygienicP hygienicP),
92− _rangeLength = Nothing,
95− changeDoc doc [change]
96− either (not . null) (not . null) <$> getDocumentSymbols doc,
97− ---------------------------------------------------------------------------------------
98− bench "completions after edit" 10 $ \doc -> do
100− TextDocumentContentChangeEvent
101− { _range = Just (Range hygienicP hygienicP),
102− _rangeLength = Nothing,
105− changeDoc doc [change]
106− not . null <$> getCompletions doc identifierP,
107− ---------------------------------------------------------------------------------------
114− TextDocumentContentChangeEvent
115− { _range = Just (Range p p),
116− _rangeLength = Nothing,
119− changeDoc doc [change]
120− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
124− not . null <$> getCodeActions doc (Range p p)
126− ---------------------------------------------------------------------------------------
127− bench "code actions after edit" 10 $ \doc -> do
130− TextDocumentContentChangeEvent
131− { _range = Just (Range p p),
132− _rangeLength = Nothing,
135− changeDoc doc [change]
136− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
137− not . null <$> getCodeActions doc (Range p p)
141−---------------------------------------------------------------------------------------------
143−examplePackageName :: String
144−examplePackageName = "Cabal"
146−examplePackageVersion :: Version
147−examplePackageVersion = makeVersion [3, 2, 0, 0]
149−examplePackage :: String
150−examplePackage = examplePackageName <> "-" <> showVersion examplePackageVersion
152−exampleModulePath :: FilePath
153−exampleModulePath = "Distribution" </> "Simple.hs"
155−examplesPath :: FilePath
156−examplesPath = "bench/example"
160− -- For some reason, the Shake profile files are truncated and won't load
161− shakeProfiling :: !(Maybe FilePath),
165−type HasConfig = (?config :: Config)
167−configP :: Parser Config
169− <$> (not <$> switch (long "quiet"))
170− <*> optional (strOption (long "shake-profiling" <> metavar "PATH"))
171− <*> switch (long "csv")
173−output :: (MonadIO m, HasConfig) => String -> m ()
174−output = if verbose ?config then liftIO . putStrLn else (\_ -> pure ())
176−---------------------------------------------------------------------------------------
178−type Experiment = TextDocumentIdentifier -> Session Bool
180−data Bench = forall setup.
183− samples :: !Natural,
184− benchSetup :: TextDocumentIdentifier -> Session setup,
185− experiment :: setup -> Experiment
188−bench :: String -> Natural -> Experiment -> Bench
189−bench name samples userExperiment = Bench {..}
191− experiment () = userExperiment
192− benchSetup _ = return ()
197− (TextDocumentIdentifier -> Session p) ->
198− (p -> Experiment) ->
200−benchWithSetup = Bench
202−runBenchmarks :: HasConfig => [Bench] -> IO ()
203−runBenchmarks benchmarks = do
204− results <- forM benchmarks $ \b -> (b,) <$> runBench b
206− forM_ results $ \(Bench {name, samples}, duration) ->
211− <> showDuration duration
216− when (outputCSV ?config) $ do
217− putStrLn $ intercalate ", " $ map name benchmarks
218− putStrLn $ intercalate ", " $ map (showDuration . snd) results
220−runBench :: HasConfig => Bench -> IO Seconds
221−runBench Bench {..} = handleAny (\e -> print e >> return (-1))
222− $ runSessionWithConfig conf cmd lspTestCaps dir
224− doc <- openDoc exampleModulePath "haskell"
225− void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
227− liftIO $ output $ "Running " <> name <> " benchmark"
228− userState <- benchSetup doc
229− let loop 0 = return True
231− (t, res) <- duration $ experiment userState doc
235− output (showDuration t)
238− (t, res) <- duration $ loop samples
241− -- sleeep to give ghcide a chance to print the RTS stats
242− liftIO $ threadDelay 50000
244− return $ if res then t else -1
257− [ ["--shake-profiling", path]
258− | Just path <- [shakeProfiling ?config]
260− dir = "bench/example/" <> examplePackage
262− fullCaps {_window = Just $ WindowClientCapabilities $ Just True}
265− { logStdErr = verbose ?config,
266− logMessages = False,
270−setup :: HasConfig => IO (IO ())
272− alreadyExists <- doesDirectoryExist examplesPath
273− when alreadyExists $ removeDirectoryRecursive examplesPath
274− callCommand $ "cabal get -v0 " <> examplePackage <> " -d " <> examplesPath
276− (examplesPath </> examplePackage </> "hie.yaml")
277− ("cradle: {cabal: {component: " <> show examplePackageName <> "}}")
279− whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True
281− return $ removeDirectoryRecursive examplesPath
283−-- | Asks the server to shutdown and exit politely
284−exitServer :: Session ()
285−exitServer = request_ Shutdown (Nothing :: Maybe Value) >> sendNotification Exit ExitParams
287−--------------------------------------------------------------------------------------------