Add a new benchmark example to characterise multi-component performan…

…ce (#1326) * [ghcide-bench] handle main modules * [ghcide-bench] use gen-hie * [benchmark] Add the HLS benchmark example * Tweak down the number of components * Update mergify conditions Co-authored-by: Javier Neira <[email protected]>
haskell · Feb 12, 2021 · 5cfe4ec · 5cfe4ec
1 parent b2ea71d
commit 5cfe4ec
Show file tree

Hide file tree

Showing 7 changed files with 46 additions and 28 deletions.
diff --git a/.github/mergify.yml b/.github/mergify.yml
@@ -7,6 +7,8 @@ pull_request_rules:
   conditions:
   - status-success=bench-example (8.10.4, ubuntu-latest, Cabal-3.0.0.0)
   - status-success=bench-example (8.10.4, ubuntu-latest, lsp-types-1.0.0.1)
+  # disabled (too slow, ~4h) until hie-bios >0.7.2 is released
+  # - status-success=bench-example (8.10.4, ubuntu-latest, bench_example_HLS)
 
   - status-success=nix (default, ubuntu-latest)
   - status-success=nix (default, macOS-latest)

diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml
@@ -81,7 +81,7 @@ jobs:
       matrix:
         ghc: ['8.10.4']
         os: [ubuntu-latest]
-        example: ['Cabal-3.0.0.0', 'lsp-types-1.0.0.1']
+        example: ['Cabal-3.0.0.0', 'lsp-types-1.0.0.1', 'bench_example_HLS']
 
     steps:
     # Cancel queued workflows from earlier commits in this branch

diff --git a/fmt.sh b/fmt.sh
@@ -1,3 +1,3 @@
 #!/usr/bin/env bash
 set -eou pipefail
-curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s ghcide/src ghcide/exe ghcide/bench shake-bench/src ghcide/test/exe --with-group=extra --hint=ghcide/.hlint.yaml
+curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s ghcide/src ghcide/exe ghcide/bench/lib ghcide/bench/exe ghcide/bench/hist shake-bench/src ghcide/test/exe --with-group=extra --hint=ghcide/.hlint.yaml
diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml
@@ -23,6 +23,16 @@ examples:
     modules:
         - src/Language/LSP/VFS.hs
         - src/Language/LSP/Types/Lens.hs
+  # Small but heavily multi-component example
+  - path: bench/example/HLS
+    modules:
+        - hls-plugin-api/src/Ide/Plugin/Config.hs
+        - ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
+        # Things get too slow with more than 2 components, hie-bios 0.7.3 will help here
+        # - ghcide/bench/hist/Main.hs
+        # - ghcide/bench/lib/Experiments/Types.hs
+        # - ghcide/test/exe/Main.hs
+        # - exe/Plugins.hs
 
 # The set of experiments to execute
 experiments:

diff --git a/ghcide/bench/example/HLS b/ghcide/bench/example/HLS
@@ -0,0 +1 @@
+../../..
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
@@ -20,7 +20,7 @@ module Experiments
 , exampleToOptions
 ) where
 import Control.Applicative.Combinators (skipManyTill)
-import Control.Exception.Safe
+import Control.Exception.Safe (IOException, handleAny, try)
 import Control.Monad.Extra
 import Control.Monad.IO.Class
 import Data.Aeson (Value(Null))
@@ -41,6 +41,7 @@ import System.FilePath ((</>), (<.>))
 import System.Process
 import System.Time.Extra
 import Text.ParserCombinators.ReadP (readP_to_S)
+import Development.Shake (cmd_, CmdOption (Cwd, FileStdout))
 
 charEdit :: Position -> TextDocumentContentChangeEvent
 charEdit p =
@@ -423,19 +424,24 @@ setup :: HasConfig => IO SetupResult
 setup = do
 --   when alreadyExists $ removeDirectoryRecursive examplesPath
   benchDir <- case example ?config of
-      UsePackage{..} -> return examplePath
+      UsePackage{..} -> do
+          let hieYamlPath = examplePath </> "hie.yaml"
+          alreadyExists <- doesFileExist hieYamlPath
+          unless alreadyExists $
+                cmd_ (Cwd examplePath) (FileStdout hieYamlPath) ("gen-hie"::String)
+          return examplePath
       GetPackage{..} -> do
         let path = examplesPath </> package
             package = exampleName <> "-" <> showVersion exampleVersion
+            hieYamlPath = path </> "hie.yaml"
         alreadySetup <- doesDirectoryExist path
         unless alreadySetup $
           case buildTool ?config of
             Cabal -> do
                 let cabalVerbosity = "-v" ++ show (fromEnum (verbose ?config))
                 callCommandLogging $ "cabal get " <> cabalVerbosity <> " " <> package <> " -d " <> examplesPath
-                writeFile
-                    (path </> "hie.yaml")
-                    ("cradle: {cabal: {component: " <> exampleName <> "}}")
+                let hieYamlPath = path </> "hie.yaml"
+                cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String)
                 -- Need this in case there is a parent cabal.project somewhere
                 writeFile
                     (path </> "cabal.project")
@@ -464,9 +470,7 @@ setup = do
                             ]
                         )
 
-                writeFile
-                    (path </> "hie.yaml")
-                    ("cradle: {stack: {component: " <> show (exampleName <> ":lib") <> "}}")
+                cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String) ["--stack"::String]
         return path
 
   whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True
@@ -498,22 +502,21 @@ setupDocumentContents config =
 
         -- Find an identifier defined in another file in this project
         symbols <- getDocumentSymbols doc
-        case symbols of
-            Left [DocumentSymbol{_children = Just (List symbols)}] -> do
-                let endOfImports = case symbols of
-                        DocumentSymbol{_kind = SkModule, _name = "imports", _range } : _ ->
-                            Position (succ $ _line $ _end _range) 4
-                        DocumentSymbol{_range} : _ -> _start _range
-                        [] -> error "Module has no symbols"
-                contents <- documentContents doc
-
-                identifierP <- searchSymbol doc contents endOfImports
-
-                return $ DocumentPositions{..}
-            other ->
-                error $ "symbols: " <> show other
-
-
+        let endOfImports = case symbols of
+                Left symbols | Just x <- findEndOfImports symbols -> x
+                _ -> error $ "symbols: " <> show symbols
+        contents <- documentContents doc
+        identifierP <- searchSymbol doc contents endOfImports
+        return $ DocumentPositions{..}
+
+findEndOfImports :: [DocumentSymbol] -> Maybe Position
+findEndOfImports (DocumentSymbol{_kind = SkModule, _name = "imports", _range} : _) =
+    Just $ Position (succ $ _line $ _end _range) 4
+findEndOfImports [DocumentSymbol{_kind = SkFile, _children = Just (List cc)}] =
+    findEndOfImports cc
+findEndOfImports (DocumentSymbol{_range} : _) =
+    Just $ _start _range
+findEndOfImports _ = Nothing
 
 --------------------------------------------------------------------------------------------
 

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
@@ -226,7 +226,8 @@ benchmark benchHist
     other-modules: Experiments.Types
     build-tool-depends:
         ghcide:ghcide-bench,
-        hp2pretty:hp2pretty
+        hp2pretty:hp2pretty,
+        implicit-hie:gen-hie
     default-extensions:
         BangPatterns
         DeriveFunctor
@@ -322,7 +323,8 @@ test-suite ghcide-tests
     default-language: Haskell2010
     build-tool-depends:
         ghcide:ghcide,
-        ghcide:ghcide-test-preprocessor
+        ghcide:ghcide-test-preprocessor,
+        implicit-hie:gen-hie
     build-depends:
         aeson,
         base,