From 0ffd75f4a3bcc7fa6b5d5677c67d2a0f9b60a711 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 09:21:12 +0000
Subject: [PATCH 01/18] [test-ci] fix wibble

---
 .github/workflows/test.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index bbac124feb..3547e82e5d 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -49,7 +49,7 @@ jobs:
             ~/.cabal/store
           key: ${{ runner.os }}-${{ matrix.ghc }}-build-${{ hashFiles('cabal.project') }}
           restore-keys: |
-            ${{ runner.os }}-${{ matrix.ghc }}-bench-$${ hashFiles('cabal.project') }}
+            ${{ runner.os }}-${{ matrix.ghc }}-bench-${{ hashFiles('cabal.project') }}
             ${{ runner.os }}-${{ matrix.ghc }}-build-
             ${{ runner.os }}-${{ matrix.ghc }}
 

From 71dd5879519117450314ea9ffc0f585644a599b5 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 09:53:19 +0000
Subject: [PATCH 02/18] [ghcide-bench] fix scrambled output

---
 ghcide/bench/exe/Main.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/ghcide/bench/exe/Main.hs b/ghcide/bench/exe/Main.hs
index 9b9ae1fac0..3c3e9bcf27 100644
--- a/ghcide/bench/exe/Main.hs
+++ b/ghcide/bench/exe/Main.hs
@@ -37,9 +37,12 @@
 import Control.Exception.Safe
 import Experiments
 import Options.Applicative
+import System.IO
 
 main :: IO ()
 main = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
   config <- execParser $ info (configP <**> helper) fullDesc
   let ?config = config
 

From c9a3f316c1d3401d17e349c9b00dde52cd5e37b5 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Fri, 1 Jan 2021 13:54:10 +0000
Subject: [PATCH 03/18] [ghcide-bench] add a new experiment: getDefinition
 after edit

---
 ghcide/bench/config.yaml        | 1 +
 ghcide/bench/lib/Experiments.hs | 4 ++++
 2 files changed, 5 insertions(+)

diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml
index 26c179ab02..7b36d2c738 100644
--- a/ghcide/bench/config.yaml
+++ b/ghcide/bench/config.yaml
@@ -32,6 +32,7 @@ experiments:
     - "code actions"
     - "code actions after edit"
     - "documentSymbols after edit"
+    - "getDefinition after edit"
 
 # An ordered list of versions to analyze
 versions:
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 84ad2eaa42..723fe4bde7 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -83,6 +83,10 @@ experiments =
       bench "getDefinition" 10 $ \doc ->
         not . null <$> getDefinitions doc ?identifierP,
       ---------------------------------------------------------------------------------------
+      bench "getDefinition after edit" 10 $ \doc -> do
+        changeDoc doc [hygienicEdit]
+        not . null <$> getDefinitions doc ?identifierP,
+      ---------------------------------------------------------------------------------------
       bench "documentSymbols" 100 $
         fmap (either (not . null) (not . null)) . getDocumentSymbols,
       ---------------------------------------------------------------------------------------

From 852672a83bdeec17d056bd90417c5487323fff69 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Fri, 1 Jan 2021 18:52:47 +0000
Subject: [PATCH 04/18] [ghcide-bench] refine the position used for identifiers

---
 ghcide/bench/config.yaml        | 14 ++++----
 ghcide/bench/lib/Experiments.hs | 62 +++++++++++++++++++++++++++------
 2 files changed, 59 insertions(+), 17 deletions(-)

diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml
index 7b36d2c738..1d6d6e8c3f 100644
--- a/ghcide/bench/config.yaml
+++ b/ghcide/bench/config.yaml
@@ -16,23 +16,23 @@ examples:
     version: 3.0.0.0
     module: Distribution/Simple.hs
   # Small-sized project with TH
-  - name: haskell-lsp-types
-    version: 0.22.0.0
-    module: src/Language/Haskell/LSP/Types/Lens.hs
+  - name: lsp-types
+    version: 1.0.0.1
+    module: src/Language/LSP/VFS.hs
 # - path: path-to-example
 #   module: path-to-module
 
 # The set of experiments to execute
 experiments:
-    - hover
-    - edit
-    - getDefinition
+    - "edit"
+    - "hover"
     - "hover after edit"
+    - "getDefinition"
+    - "getDefinition after edit"
     - "completions after edit"
     - "code actions"
     - "code actions after edit"
     - "documentSymbols after edit"
-    - "getDefinition after edit"
 
 # An ordered list of versions to analyze
 versions:
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 723fe4bde7..dfd9099b36 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -343,24 +343,33 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
     changeDoc doc [TextDocumentContentChangeEvent
         { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
         , _rangeLength = Nothing
-        , _text = T.unlines
-               [ "_hygienic = \"hygienic\""
-               , "_identifier = _hygienic"
-               ]
+        , _text = T.unlines [ "_hygienic = \"hygienic\"" ]
         }]
     let
       -- Points to a string in the target file,
       -- convenient for hygienic edits
       ?hygienicP = Position lastLine 15
-    let
-      -- Points to the middle of an identifier,
-      -- convenient for requesting goto-def, hover and completions
-      ?identifierP = Position (lastLine+1) 15
+
+    -- Find an identifier defined in another file in this project
+    Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
+
+    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
+    liftIO $ print identifierP
+
+    let ?identifierP =
+            fromMaybe (error $ "Failed to find a benchmark position in document: " <> exampleModulePath)
+                      identifierP
 
     case b of
      Bench{..} -> do
       (startup, _) <- duration $ do
-        waitForProgressDone
         -- wait again, as the progress is restarted once while loading the cradle
         -- make an edit, to ensure this doesn't block
         changeDoc doc [hygienicEdit]
@@ -373,7 +382,7 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
             (t, res) <- duration $ experiment userState doc
             if not res
               then return Nothing
-              else do
+            else do
                 output (showDuration t)
                 -- Wait for the delayed actions to finish
                 waitId <- sendRequest (CustomClientMethod "test") WaitForShakeQueue
@@ -486,3 +495,36 @@ pad n (x:xx) = x : pad (n-1) xx
 
 showMB :: Int -> String
 showMB x = show (x `div` 2^(20::Int)) <> "MB"
+
+-- | Search for a position where:
+--     - get definition works and returns a uri other than this file
+--     - get completions returns a non empty list
+searchSymbol :: TextDocumentIdentifier -> T.Text -> Position -> Session (Maybe Position)
+searchSymbol doc@TextDocumentIdentifier{_uri} fileContents =
+    loop
+  where
+      loop pos
+        | _line pos >= lll =
+            return Nothing
+        | _character pos >= lengthOfLine (_line pos) =
+            loop (nextLine pos)
+        | otherwise = do
+                checks <- checkDefinitions pos &&^ checkCompletions pos
+                if checks
+                    then return $ Just pos
+                    else loop (nextIdent pos)
+
+      nextIdent p = p{_character = _character p + 2}
+      nextLine p = Position (_line p + 1) 4
+
+      lengthOfLine n = if n >= lll then 0 else T.length (ll !! n)
+      ll = T.lines fileContents
+      lll = length ll
+
+      checkDefinitions pos = do
+        defs <- getDefinitions doc pos
+        case defs of
+            [Location uri _] -> return $ uri /= _uri
+            _ -> return False
+      checkCompletions pos =
+        not . null <$> getCompletions doc pos

From 4a636ed53ab093266c1151699d32c1c9b50e365b Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Fri, 1 Jan 2021 21:40:45 +0000
Subject: [PATCH 05/18] [ghcide-bench] Support examples with multiple FOIs

---
 ghcide/bench/config.yaml              |   2 +
 ghcide/bench/hist/Main.hs             |   4 +-
 ghcide/bench/lib/Experiments.hs       | 182 ++++++++++++--------------
 ghcide/bench/lib/Experiments/Types.hs |  15 ++-
 4 files changed, 96 insertions(+), 107 deletions(-)

diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml
index 1d6d6e8c3f..2a99474424 100644
--- a/ghcide/bench/config.yaml
+++ b/ghcide/bench/config.yaml
@@ -15,10 +15,12 @@ examples:
   - name: Cabal
     version: 3.0.0.0
     module: Distribution/Simple.hs
+    module: Distribution/Types/Module.hs
   # Small-sized project with TH
   - name: lsp-types
     version: 1.0.0.1
     module: src/Language/LSP/VFS.hs
+    module: src/Language/LSP/Types/Lens.hs
 # - path: path-to-example
 #   module: path-to-module
 
diff --git a/ghcide/bench/hist/Main.hs b/ghcide/bench/hist/Main.hs
index 2a9956631c..76b9f46166 100644
--- a/ghcide/bench/hist/Main.hs
+++ b/ghcide/bench/hist/Main.hs
@@ -98,8 +98,8 @@ createBuildSystem userRules = do
 
   _ <- addOracle $ \GetExperiments {} -> experiments <$> readConfig config
   _ <- addOracle $ \GetVersions {} -> versions <$> readConfig config
-  _ <- addOracle $ \GetExamples{} -> examples <$> readConfig config
-  _ <- addOracle $ \(GetExample name) -> find (\e -> getExampleName e == name) . examples <$> readConfig config
+  _ <- versioned 1 $ addOracle $ \GetExamples{} -> examples <$> readConfig config
+  _ <- versioned 1 $ addOracle $ \(GetExample name) -> find (\e -> getExampleName e == name) . examples <$> readConfig config
   _ <- addOracle $ \GetBuildSystem {} -> buildTool <$> readConfig config
 
   benchResource <- newResource "ghcide-bench" 1
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index dfd9099b36..575cbbd1ad 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -44,81 +44,71 @@ import System.Process
 import System.Time.Extra
 import Text.ParserCombinators.ReadP (readP_to_S)
 
-hygienicEdit :: (?hygienicP :: Position) => TextDocumentContentChangeEvent
-hygienicEdit =
+charEdit :: Position -> TextDocumentContentChangeEvent
+charEdit p =
     TextDocumentContentChangeEvent
-    { _range = Just (Range ?hygienicP ?hygienicP),
-        _rangeLength = Nothing,
-        _text = " "
-    }
-
-breakingEdit :: (?identifierP :: Position) => TextDocumentContentChangeEvent
-breakingEdit =
-    TextDocumentContentChangeEvent
-    { _range = Just (Range ?identifierP ?identifierP),
+    { _range = Just (Range p p),
         _rangeLength = Nothing,
         _text = "a"
     }
 
--- | Experiments have access to these special positions:
--- - hygienicP points to a string in the target file, convenient for hygienic edits
--- - identifierP points to the middle of an identifier, convenient for goto-def, hover and completions
-type HasPositions = (?hygienicP :: Position, ?identifierP :: Position)
+data DocumentPositions = DocumentPositions {
+    identifierP, stringLiteralP :: !Position,
+    doc :: !TextDocumentIdentifier
+}
 
 experiments :: [Bench]
 experiments =
     [ ---------------------------------------------------------------------------------------
-      bench "hover" 10 $ \doc ->
-        isJust <$> getHover doc ?identifierP,
+      bench "hover" 10 $ allM $ \DocumentPositions{..} ->
+        isJust <$> getHover doc identifierP,
       ---------------------------------------------------------------------------------------
-      bench "edit" 10 $ \doc -> do
-        changeDoc doc [hygienicEdit]
+      bench "edit" 10 $  allM $ \DocumentPositions{..} -> do
+        changeDoc doc [charEdit stringLiteralP]
         waitForProgressDone
         return True,
       ---------------------------------------------------------------------------------------
-      bench "hover after edit" 10 $ \doc -> do
-        changeDoc doc [hygienicEdit]
-        isJust <$> getHover doc ?identifierP,
+      bench "hover after edit" 10 $ allM $ \DocumentPositions{..} -> do
+        changeDoc doc [charEdit stringLiteralP]
+        isJust <$> getHover doc identifierP,
       ---------------------------------------------------------------------------------------
-      bench "getDefinition" 10 $ \doc ->
-        not . null <$> getDefinitions doc ?identifierP,
+      bench "getDefinition" 10 $ allM $ \DocumentPositions{..} ->
+        not . null <$> getDefinitions doc identifierP,
       ---------------------------------------------------------------------------------------
-      bench "getDefinition after edit" 10 $ \doc -> do
-        changeDoc doc [hygienicEdit]
-        not . null <$> getDefinitions doc ?identifierP,
+      bench "getDefinition after edit" 10 $ allM $ \DocumentPositions{..} -> do
+        changeDoc doc [charEdit stringLiteralP]
+        not . null <$> getDefinitions doc identifierP,
       ---------------------------------------------------------------------------------------
-      bench "documentSymbols" 100 $
-        fmap (either (not . null) (not . null)) . getDocumentSymbols,
+      bench "documentSymbols" 100 $ allM $ \DocumentPositions{..} -> do
+        fmap (either (not . null) (not . null)) . getDocumentSymbols $ doc,
       ---------------------------------------------------------------------------------------
-      bench "documentSymbols after edit" 100 $ \doc -> do
-        changeDoc doc [hygienicEdit]
+      bench "documentSymbols after edit" 100 $ allM $ \DocumentPositions{..} -> do
+        changeDoc doc [charEdit stringLiteralP]
         either (not . null) (not . null) <$> getDocumentSymbols doc,
       ---------------------------------------------------------------------------------------
-      bench "completions after edit" 10 $ \doc -> do
-        changeDoc doc [hygienicEdit]
-        not . null <$> getCompletions doc ?identifierP,
+      bench "completions after edit" 10 $ allM $ \DocumentPositions{..} -> do
+        changeDoc doc [charEdit stringLiteralP]
+        not . null <$> getCompletions doc identifierP,
       ---------------------------------------------------------------------------------------
       benchWithSetup
         "code actions"
         10
-        ( \doc -> do
-            changeDoc doc [breakingEdit]
+        ( mapM_ $ \DocumentPositions{..} -> do
+            changeDoc doc [charEdit identifierP]
             waitForProgressDone
-            return ?identifierP
         )
-        ( \p doc -> do
-            not . null <$> getCodeActions doc (Range p p)
+        ( allM $ \DocumentPositions{..} -> do
+            not . null <$> getCodeActions doc (Range identifierP identifierP)
         ),
       ---------------------------------------------------------------------------------------
       benchWithSetup
         "code actions after edit"
         10
-        ( \doc -> do
-            changeDoc doc [breakingEdit]
-            return ?identifierP
+        ( mapM_ $ \DocumentPositions{..} ->
+            changeDoc doc [charEdit identifierP]
         )
-        ( \p doc -> do
-            changeDoc doc [hygienicEdit]
+        ( allM $ \DocumentPositions{..} -> do
+            changeDoc doc [charEdit stringLiteralP]
             waitForProgressDone
             -- NOTE ghcide used to clear and reinstall the diagnostics here
             -- new versions no longer do, but keep this logic around
@@ -126,15 +116,12 @@ experiments =
             diags <- getCurrentDiagnostics doc
             when (null diags) $
               whileM (null <$> waitForDiagnostics)
-            not . null <$> getCodeActions doc (Range p p)
+            not . null <$> getCodeActions doc (Range identifierP identifierP)
         )
     ]
 
 ---------------------------------------------------------------------------------------------
 
-exampleModulePath :: HasConfig => FilePath
-exampleModulePath = exampleModule (example ?config)
-
 examplesPath :: FilePath
 examplesPath = "bench/example"
 
@@ -164,14 +151,14 @@ configP =
     <*> strOption (long "ghcide" <> metavar "PATH" <> help "path to ghcide" <> value "ghcide")
     <*> option auto (long "timeout" <> value 60 <> help "timeout for waiting for a ghcide response")
     <*> ( GetPackage <$> strOption (long "example-package-name" <> value "Cabal")
-               <*> moduleOption
+               <*> (some moduleOption <|> pure ["Distribution/Simple.hs"])
                <*> option versionP (long "example-package-version" <> value (makeVersion [3,2,0,0]))
          <|>
           UsePackage <$> strOption (long "example-path")
-                     <*> moduleOption
+                     <*> some moduleOption
          )
   where
-      moduleOption = strOption (long "example-module" <> metavar "PATH" <> value "Distribution/Simple.hs")
+      moduleOption = strOption (long "example-module" <> metavar "PATH")
 
 versionP :: ReadM Version
 versionP = maybeReader $ extract . readP_to_S parseVersion
@@ -183,15 +170,15 @@ output = if quiet?config then (\_ -> pure ()) else liftIO . putStrLn
 
 ---------------------------------------------------------------------------------------
 
-type Experiment = TextDocumentIdentifier -> Session Bool
+type Experiment = [DocumentPositions] -> Session Bool
 
-data Bench = forall setup.
+data Bench =
   Bench
   { name :: !String,
     enabled :: !Bool,
     samples :: !Natural,
-    benchSetup :: HasPositions => TextDocumentIdentifier -> Session setup,
-    experiment :: HasPositions => setup -> Experiment
+    benchSetup :: [DocumentPositions] -> Session (),
+    experiment :: Experiment
   }
 
 select :: HasConfig => Bench -> Bool
@@ -203,18 +190,16 @@ select Bench {name, enabled} =
 benchWithSetup ::
   String ->
   Natural ->
-  (HasPositions => TextDocumentIdentifier -> Session p) ->
-  (HasPositions => p -> Experiment) ->
+  ([DocumentPositions] -> Session ()) ->
+  Experiment ->
   Bench
 benchWithSetup name samples benchSetup experiment = Bench {..}
   where
     enabled = True
 
-bench :: String -> Natural -> (HasPositions => Experiment) -> Bench
-bench name defSamples userExperiment =
-  benchWithSetup name defSamples (const $ pure ()) experiment
-  where
-    experiment () = userExperiment
+bench :: String -> Natural -> Experiment -> Bench
+bench name defSamples =
+  benchWithSetup name defSamples (const $ pure ())
 
 runBenchmarksFun :: HasConfig => FilePath -> [Bench] -> IO ()
 runBenchmarksFun dir allBenchmarks = do
@@ -331,55 +316,57 @@ waitForProgressDone =
 runBench ::
   (?config :: Config) =>
   (Session BenchRun -> IO BenchRun) ->
-  (HasPositions => Bench) ->
+  Bench ->
   IO BenchRun
 runBench runSess b = handleAny (\e -> print e >> return badRun)
   $ runSess
   $ do
-    doc <- openDoc exampleModulePath "haskell"
-
-    -- Setup the special positions used by the experiments
-    lastLine <- length . T.lines <$> documentContents doc
-    changeDoc doc [TextDocumentContentChangeEvent
-        { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
-        , _rangeLength = Nothing
-        , _text = T.unlines [ "_hygienic = \"hygienic\"" ]
-        }]
-    let
-      -- Points to a string in the target file,
-      -- convenient for hygienic edits
-      ?hygienicP = Position lastLine 15
-
-    -- Find an identifier defined in another file in this project
-    Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
-
-    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
-    liftIO $ print identifierP
-
-    let ?identifierP =
-            fromMaybe (error $ "Failed to find a benchmark position in document: " <> exampleModulePath)
-                      identifierP
+    docs <- forM (exampleModules $ example ?config) $ \m -> do
+        doc <- openDoc m "haskell"
+
+        -- Setup the special positions used by the experiments
+        lastLine <- length . T.lines <$> documentContents doc
+        changeDoc doc [TextDocumentContentChangeEvent
+            { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
+            , _rangeLength = Nothing
+            , _text = T.unlines [ "_hygienic = \"hygienic\"" ]
+            }]
+        let
+        -- Points to a string in the target file,
+        -- convenient for hygienic edits
+            stringLiteralP = Position lastLine 15
+
+        -- Find an identifier defined in another file in this project
+        Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
+
+        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
+
+        mb_identifierP <- searchSymbol doc contents endOfImports
+
+        let identifierP =
+              fromMaybe (error $ "Failed to find a benchmark position in document: " <> m)
+                        mb_identifierP
+        return $ DocumentPositions{..}
 
     case b of
      Bench{..} -> do
       (startup, _) <- duration $ do
         -- wait again, as the progress is restarted once while loading the cradle
         -- make an edit, to ensure this doesn't block
-        changeDoc doc [hygienicEdit]
+        let DocumentPositions{..} = head docs
+        changeDoc doc [charEdit stringLiteralP]
         waitForProgressDone
 
       liftIO $ output $ "Running " <> name <> " benchmark"
-      (runSetup, userState) <- duration $ benchSetup doc
+      (runSetup, ()) <- duration $ benchSetup docs
       let loop !userWaits !delayedWork 0 = return $ Just (userWaits, delayedWork)
           loop !userWaits !delayedWork n = do
-            (t, res) <- duration $ experiment userState doc
+            (t, res) <- duration $ experiment docs
             if not res
               then return Nothing
             else do
@@ -500,8 +487,7 @@ showMB x = show (x `div` 2^(20::Int)) <> "MB"
 --     - get definition works and returns a uri other than this file
 --     - get completions returns a non empty list
 searchSymbol :: TextDocumentIdentifier -> T.Text -> Position -> Session (Maybe Position)
-searchSymbol doc@TextDocumentIdentifier{_uri} fileContents =
-    loop
+searchSymbol doc@TextDocumentIdentifier{_uri} fileContents = loop
   where
       loop pos
         | _line pos >= lll =
diff --git a/ghcide/bench/lib/Experiments/Types.hs b/ghcide/bench/lib/Experiments/Types.hs
index 350f89ad94..8232e9d7f4 100644
--- a/ghcide/bench/lib/Experiments/Types.hs
+++ b/ghcide/bench/lib/Experiments/Types.hs
@@ -32,8 +32,8 @@ data Config = Config
   deriving (Eq, Show)
 
 data Example
-    = GetPackage {exampleName, exampleModule :: String, exampleVersion :: Version}
-    | UsePackage {examplePath :: FilePath, exampleModule :: String}
+    = GetPackage {exampleName :: !String, exampleModules :: [FilePath], exampleVersion :: Version}
+    | UsePackage {examplePath :: FilePath, exampleModules :: [FilePath]}
   deriving (Eq, Generic, Show)
   deriving anyclass (Binary, Hashable, NFData)
 
@@ -48,7 +48,8 @@ getExampleName GetPackage{exampleName, exampleVersion} =
 
 instance FromJSON Example where
     parseJSON = withObject "example" $ \x -> do
-        exampleModule <- x .: "module"
+        exampleModules <- x .: "modules"
+
         path <- x .:? "path"
         case path of
             Just examplePath -> return UsePackage{..}
@@ -61,9 +62,9 @@ exampleToOptions :: Example -> [String]
 exampleToOptions GetPackage{..} =
     ["--example-package-name", exampleName
     ,"--example-package-version", showVersion exampleVersion
-    ,"--example-module", exampleModule
-    ]
+    ] ++
+    ["--example-module=" <> m | m <- exampleModules]
 exampleToOptions UsePackage{..} =
     ["--example-path", examplePath
-    ,"--example-module", exampleModule
-    ]
+    ] ++
+    ["--example-module=" <> m | m <- exampleModules]

From aa4790404bdd75f601f9154168473802543eef3b Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Fri, 1 Jan 2021 21:49:03 +0000
Subject: [PATCH 06/18] [ghcide-bench] Allow identifierP to be optional

---
 ghcide/bench/lib/Experiments.hs | 129 ++++++++++++++++++--------------
 1 file changed, 73 insertions(+), 56 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 575cbbd1ad..4e86450855 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -53,31 +53,35 @@ charEdit p =
     }
 
 data DocumentPositions = DocumentPositions {
-    identifierP, stringLiteralP :: !Position,
+    identifierP :: Maybe Position,
+    stringLiteralP :: !Position,
     doc :: !TextDocumentIdentifier
 }
 
+allWithIdentifierPos :: Monad m => (DocumentPositions -> m Bool) -> [DocumentPositions] -> m Bool
+allWithIdentifierPos f docs = allM f (filter (isJust . identifierP) docs)
+
 experiments :: [Bench]
 experiments =
     [ ---------------------------------------------------------------------------------------
-      bench "hover" 10 $ allM $ \DocumentPositions{..} ->
-        isJust <$> getHover doc identifierP,
+      bench "hover" 10 $ allWithIdentifierPos $ \DocumentPositions{..} ->
+        isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "edit" 10 $  allM $ \DocumentPositions{..} -> do
         changeDoc doc [charEdit stringLiteralP]
         waitForProgressDone
         return True,
       ---------------------------------------------------------------------------------------
-      bench "hover after edit" 10 $ allM $ \DocumentPositions{..} -> do
+      bench "hover after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
         changeDoc doc [charEdit stringLiteralP]
-        isJust <$> getHover doc identifierP,
+        isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
-      bench "getDefinition" 10 $ allM $ \DocumentPositions{..} ->
-        not . null <$> getDefinitions doc identifierP,
+      bench "getDefinition" 10 $ allWithIdentifierPos $ \DocumentPositions{..} ->
+        not . null <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
-      bench "getDefinition after edit" 10 $ allM $ \DocumentPositions{..} -> do
+      bench "getDefinition after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
         changeDoc doc [charEdit stringLiteralP]
-        not . null <$> getDefinitions doc identifierP,
+        not . null <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "documentSymbols" 100 $ allM $ \DocumentPositions{..} -> do
         fmap (either (not . null) (not . null)) . getDocumentSymbols $ doc,
@@ -86,28 +90,35 @@ experiments =
         changeDoc doc [charEdit stringLiteralP]
         either (not . null) (not . null) <$> getDocumentSymbols doc,
       ---------------------------------------------------------------------------------------
-      bench "completions after edit" 10 $ allM $ \DocumentPositions{..} -> do
+      bench "completions after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
         changeDoc doc [charEdit stringLiteralP]
-        not . null <$> getCompletions doc identifierP,
+        not . null <$> getCompletions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       benchWithSetup
         "code actions"
         10
-        ( mapM_ $ \DocumentPositions{..} -> do
-            changeDoc doc [charEdit identifierP]
-            waitForProgressDone
+        ( \docs -> do
+            unless (any (isJust . identifierP) docs) $
+                error "None of the example modules is suitable for this experiment"
+            forM_ docs $ \DocumentPositions{..} ->
+                forM_ identifierP $ \p -> changeDoc doc [charEdit p]
+                waitForProgressDone
         )
-        ( allM $ \DocumentPositions{..} -> do
-            not . null <$> getCodeActions doc (Range identifierP identifierP)
+        ( allWithIdentifierPos $ \DocumentPositions{..} -> do
+            let p = fromJust identifierP
+            not . null <$> getCodeActions doc (Range p p)
         ),
       ---------------------------------------------------------------------------------------
       benchWithSetup
         "code actions after edit"
         10
-        ( mapM_ $ \DocumentPositions{..} ->
-            changeDoc doc [charEdit identifierP]
+        ( \docs -> do
+            unless (any (isJust . identifierP) docs) $
+                error "None of the example modules is suitable for this experiment"
+            forM_ docs $ \DocumentPositions{..} ->
+                forM_ identifierP $ \p -> changeDoc doc [charEdit p]
         )
-        ( allM $ \DocumentPositions{..} -> do
+        ( allWithIdentifierPos $ \DocumentPositions{..} -> do
             changeDoc doc [charEdit stringLiteralP]
             waitForProgressDone
             -- NOTE ghcide used to clear and reinstall the diagnostics here
@@ -116,7 +127,8 @@ experiments =
             diags <- getCurrentDiagnostics doc
             when (null diags) $
               whileM (null <$> waitForDiagnostics)
-            not . null <$> getCodeActions doc (Range identifierP identifierP)
+            let p = fromJust identifierP
+            not . null <$> getCodeActions doc (Range p p)
         )
     ]
 
@@ -210,9 +222,9 @@ runBenchmarksFun dir allBenchmarks = do
   whenJust (otMemoryProfiling ?config) $ \eventlogDir ->
       createDirectoryIfMissing True eventlogDir
 
-  results <- forM benchmarks $ \b@Bench{name} ->
+  results <- forM benchmarks $ \b@Bench{name} -> do
                 let run = runSessionWithConfig conf (cmd name dir) lspTestCaps dir
-                in (b,) <$> runBench run b
+                (b,) <$> runBench run b
 
   -- output raw data as CSV
   let headers =
@@ -267,14 +279,16 @@ runBenchmarksFun dir allBenchmarks = do
   outputRow $ (map . map) (const '-') paddedHeaders
   forM_ rowsHuman $ \row -> outputRow $ zipWith pad pads row
   where
-    cmd name dir =
-      unwords $
+    ghcideCmd dir =
         [ ghcide ?config,
           "--lsp",
           "--test",
           "--cwd",
           dir
         ]
+    cmd name dir =
+      unwords $
+            ghcideCmd dir
           ++ case otMemoryProfiling ?config of
             Just dir -> ["-l", "-ol" ++ (dir </> map (\c -> if c == ' ' then '-' else c) name <.> "eventlog")]
             Nothing -> []
@@ -321,38 +335,8 @@ runBench ::
 runBench runSess b = handleAny (\e -> print e >> return badRun)
   $ runSess
   $ do
-    docs <- forM (exampleModules $ example ?config) $ \m -> do
-        doc <- openDoc m "haskell"
-
-        -- Setup the special positions used by the experiments
-        lastLine <- length . T.lines <$> documentContents doc
-        changeDoc doc [TextDocumentContentChangeEvent
-            { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
-            , _rangeLength = Nothing
-            , _text = T.unlines [ "_hygienic = \"hygienic\"" ]
-            }]
-        let
-        -- Points to a string in the target file,
-        -- convenient for hygienic edits
-            stringLiteralP = Position lastLine 15
-
-        -- Find an identifier defined in another file in this project
-        Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
-
-        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
-
-        mb_identifierP <- searchSymbol doc contents endOfImports
-
-        let identifierP =
-              fromMaybe (error $ "Failed to find a benchmark position in document: " <> m)
-                        mb_identifierP
-        return $ DocumentPositions{..}
-
+    (d, docs) <- duration $ setupDocumentContents ?config
+    output $ "Setting up document contents took " <> showDuration d
     case b of
      Bench{..} -> do
       (startup, _) <- duration $ do
@@ -457,6 +441,39 @@ setup = do
 
   return SetupResult{..}
 
+setupDocumentContents :: Config -> Session [DocumentPositions]
+setupDocumentContents config =
+        forM (exampleModules $ example config) $ \m -> do
+        doc <- openDoc m "haskell"
+
+        -- Setup the special positions used by the experiments
+        lastLine <- length . T.lines <$> documentContents doc
+        changeDoc doc [TextDocumentContentChangeEvent
+            { _range = Just (Range (Position lastLine 0) (Position lastLine 0))
+            , _rangeLength = Nothing
+            , _text = T.unlines [ "_hygienic = \"hygienic\"" ]
+            }]
+        let
+        -- Points to a string in the target file,
+        -- convenient for hygienic edits
+            stringLiteralP = Position lastLine 15
+
+        -- Find an identifier defined in another file in this project
+        Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
+
+        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{..}
+
+
+
 --------------------------------------------------------------------------------------------
 
 -- Parse the max residency and allocations in RTS -s output

From 58bebdc4d482f288d87d0c0e5e79585c9cf5d7a3 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Fri, 1 Jan 2021 21:59:33 +0000
Subject: [PATCH 07/18] [ghcide-bench] experiments: do all edits first, then
 query

---
 ghcide/bench/lib/Experiments.hs | 63 ++++++++++++++++++---------------
 1 file changed, 34 insertions(+), 29 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 4e86450855..e7d030bc97 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -67,32 +67,41 @@ experiments =
       bench "hover" 10 $ allWithIdentifierPos $ \DocumentPositions{..} ->
         isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
-      bench "edit" 10 $  allM $ \DocumentPositions{..} -> do
-        changeDoc doc [charEdit stringLiteralP]
-        waitForProgressDone
+      bench "edit" 10 $ \docs -> do
+        forM_ docs $ \DocumentPositions{..} ->
+          changeDoc doc [charEdit stringLiteralP]
+        waitForProgressDone -- TODO check that this waits for all of them
         return True,
       ---------------------------------------------------------------------------------------
-      bench "hover after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
-        changeDoc doc [charEdit stringLiteralP]
-        isJust <$> getHover doc (fromJust identifierP),
+      bench "hover after edit" 10 $ \docs -> do
+        forM_ docs $ \DocumentPositions{..} ->
+          changeDoc doc [charEdit stringLiteralP]
+        flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
+          isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "getDefinition" 10 $ allWithIdentifierPos $ \DocumentPositions{..} ->
         not . null <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
-      bench "getDefinition after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
-        changeDoc doc [charEdit stringLiteralP]
-        not . null <$> getDefinitions doc (fromJust identifierP),
+      bench "getDefinition after edit" 10 $ \docs -> do
+          forM_ docs $ \DocumentPositions{..} ->
+            changeDoc doc [charEdit stringLiteralP]
+          flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
+            not . null <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "documentSymbols" 100 $ allM $ \DocumentPositions{..} -> do
         fmap (either (not . null) (not . null)) . getDocumentSymbols $ doc,
       ---------------------------------------------------------------------------------------
-      bench "documentSymbols after edit" 100 $ allM $ \DocumentPositions{..} -> do
-        changeDoc doc [charEdit stringLiteralP]
-        either (not . null) (not . null) <$> getDocumentSymbols doc,
+      bench "documentSymbols after edit" 100 $ \docs -> do
+        forM_ docs $ \DocumentPositions{..} ->
+          changeDoc doc [charEdit stringLiteralP]
+        flip allM docs $ \DocumentPositions{..} ->
+          either (not . null) (not . null) <$> getDocumentSymbols doc,
       ---------------------------------------------------------------------------------------
-      bench "completions after edit" 10 $ allWithIdentifierPos $ \DocumentPositions{..} -> do
-        changeDoc doc [charEdit stringLiteralP]
-        not . null <$> getCompletions doc (fromJust identifierP),
+      bench "completions after edit" 10 $ \docs -> do
+        forM_ docs $ \DocumentPositions{..} ->
+          changeDoc doc [charEdit stringLiteralP]
+        flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
+          not . null <$> getCompletions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       benchWithSetup
         "code actions"
@@ -102,11 +111,11 @@ experiments =
                 error "None of the example modules is suitable for this experiment"
             forM_ docs $ \DocumentPositions{..} ->
                 forM_ identifierP $ \p -> changeDoc doc [charEdit p]
-                waitForProgressDone
+            waitForProgressDone
         )
-        ( allWithIdentifierPos $ \DocumentPositions{..} -> do
-            let p = fromJust identifierP
-            not . null <$> getCodeActions doc (Range p p)
+        ( \docs -> not . null . catMaybes <$> forM docs (\DocumentPositions{..} ->
+            forM identifierP $ \p ->
+              getCodeActions doc (Range p p))
         ),
       ---------------------------------------------------------------------------------------
       benchWithSetup
@@ -118,17 +127,13 @@ experiments =
             forM_ docs $ \DocumentPositions{..} ->
                 forM_ identifierP $ \p -> changeDoc doc [charEdit p]
         )
-        ( allWithIdentifierPos $ \DocumentPositions{..} -> do
-            changeDoc doc [charEdit stringLiteralP]
+        ( \docs -> do
+            forM_ docs $ \DocumentPositions{..} ->
+              changeDoc doc [charEdit stringLiteralP]
             waitForProgressDone
-            -- NOTE ghcide used to clear and reinstall the diagnostics here
-            -- new versions no longer do, but keep this logic around
-            -- to benchmark old versions sucessfully
-            diags <- getCurrentDiagnostics doc
-            when (null diags) $
-              whileM (null <$> waitForDiagnostics)
-            let p = fromJust identifierP
-            not . null <$> getCodeActions doc (Range p p)
+            not . null . catMaybes <$> forM docs (\DocumentPositions{..} -> do
+              forM identifierP $ \p ->
+                getCodeActions doc (Range p p))
         )
     ]
 

From 522460231456196ae5380a5aac0188575716c7bd Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 07:55:15 +0000
Subject: [PATCH 08/18] [ghcide-bench] Add examples with multiple FOIs

---
 ghcide/bench/config.yaml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml
index 2a99474424..6748b339a5 100644
--- a/ghcide/bench/config.yaml
+++ b/ghcide/bench/config.yaml
@@ -14,15 +14,15 @@ examples:
   # Medium-sized project without TH
   - name: Cabal
     version: 3.0.0.0
-    module: Distribution/Simple.hs
-    module: Distribution/Types/Module.hs
+    modules:
+        - Distribution/Simple.hs
+        - Distribution/Types/Module.hs
   # Small-sized project with TH
   - name: lsp-types
     version: 1.0.0.1
-    module: src/Language/LSP/VFS.hs
-    module: src/Language/LSP/Types/Lens.hs
-# - path: path-to-example
-#   module: path-to-module
+    modules:
+        - src/Language/LSP/VFS.hs
+        - src/Language/LSP/Types/Lens.hs
 
 # The set of experiments to execute
 experiments:

From 14e97942b96cf4d1ebcef566d0f645d0260d3453 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 20:14:35 +0000
Subject: [PATCH 09/18] [ghcide-bench] add a completions (without edit)
 experiment

---
 ghcide/bench/lib/Experiments.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index e7d030bc97..30a9e84d53 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -97,6 +97,10 @@ experiments =
         flip allM docs $ \DocumentPositions{..} ->
           either (not . null) (not . null) <$> getDocumentSymbols doc,
       ---------------------------------------------------------------------------------------
+      bench "completions" 10 $ \docs -> do
+        flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
+          not . null <$> getCompletions doc (fromJust identifierP),
+      ---------------------------------------------------------------------------------------
       bench "completions after edit" 10 $ \docs -> do
         forM_ docs $ \DocumentPositions{..} ->
           changeDoc doc [charEdit stringLiteralP]

From 940d160a7b51588f3b74b5ba5ae2dd2c3d1e8348 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 18:57:41 +0000
Subject: [PATCH 10/18] [ghcide-bench] Fix indentation

---
 ghcide/bench/lib/Experiments.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 30a9e84d53..03affb3112 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -48,8 +48,8 @@ charEdit :: Position -> TextDocumentContentChangeEvent
 charEdit p =
     TextDocumentContentChangeEvent
     { _range = Just (Range p p),
-        _rangeLength = Nothing,
-        _text = "a"
+      _rangeLength = Nothing,
+      _text = "a"
     }
 
 data DocumentPositions = DocumentPositions {

From a405dc83c1fbf5ccbe3e3da288c1005d42e141b0 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 2 Jan 2021 20:13:46 +0000
Subject: [PATCH 11/18] [ghcide-bench] Fix incomplete pattern match

---
 ghcide/bench/lib/Experiments.hs | 27 +++++++++++++++------------
 1 file changed, 15 insertions(+), 12 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 03affb3112..3fcc0baabb 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -468,18 +468,21 @@ setupDocumentContents config =
             stringLiteralP = Position lastLine 15
 
         -- Find an identifier defined in another file in this project
-        Left [DocumentSymbol{_children = Just (List symbols)}] <- getDocumentSymbols doc
-
-        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{..}
+        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
 
 
 

From 0aa7e1079291e0a6d0c26d9a2a195f9961643b8f Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sun, 3 Jan 2021 09:13:11 +0000
Subject: [PATCH 12/18] [ghcide-bench] Include the documentContents setup in
 the "startup" metric

---
 ghcide/bench/lib/Experiments.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 3fcc0baabb..d7b8c02d3d 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -344,16 +344,17 @@ runBench ::
 runBench runSess b = handleAny (\e -> print e >> return badRun)
   $ runSess
   $ do
-    (d, docs) <- duration $ setupDocumentContents ?config
-    output $ "Setting up document contents took " <> showDuration d
     case b of
      Bench{..} -> do
-      (startup, _) <- duration $ do
+      (startup, docs) <- duration $ do
+        (d, docs) <- duration $ setupDocumentContents ?config
+        output $ "Setting up document contents took " <> showDuration d
         -- wait again, as the progress is restarted once while loading the cradle
         -- make an edit, to ensure this doesn't block
         let DocumentPositions{..} = head docs
         changeDoc doc [charEdit stringLiteralP]
         waitForProgressDone
+        return docs
 
       liftIO $ output $ "Running " <> name <> " benchmark"
       (runSetup, ()) <- duration $ benchSetup docs

From 8edc3489b4f8a6d20b2c7fc77161fa6f46b8f3d1 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Wed, 30 Dec 2020 23:49:36 +0000
Subject: [PATCH 13/18] [ghcide-bench] fix wibble

---
 ghcide/bench/lib/Experiments.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index d7b8c02d3d..22b1de6a92 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -293,7 +293,8 @@ runBenchmarksFun dir allBenchmarks = do
           "--lsp",
           "--test",
           "--cwd",
-          dir
+          dir,
+          "+RTS"
         ]
     cmd name dir =
       unwords $

From 284a7ea63e2c401c99491eb078c5a3593f5888d1 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Wed, 30 Dec 2020 23:50:00 +0000
Subject: [PATCH 14/18] [ghcide-bench] add more verbose output

---
 ghcide/bench/exe/Main.hs        |  1 +
 ghcide/bench/lib/Experiments.hs | 14 ++++++++++++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/ghcide/bench/exe/Main.hs b/ghcide/bench/exe/Main.hs
index 3c3e9bcf27..141cfc3ad7 100644
--- a/ghcide/bench/exe/Main.hs
+++ b/ghcide/bench/exe/Main.hs
@@ -45,6 +45,7 @@ main = do
   hSetBuffering stderr LineBuffering
   config <- execParser $ info (configP <**> helper) fullDesc
   let ?config = config
+  hPrint stderr config
 
   output "starting test"
 
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 22b1de6a92..27a6bcd96c 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -398,6 +398,11 @@ data SetupResult = SetupResult {
     cleanUp :: IO ()
 }
 
+callCommandLogging :: HasConfig => String -> IO ()
+callCommandLogging cmd = do
+    output cmd
+    callCommand cmd
+
 setup :: HasConfig => IO SetupResult
 setup = do
   alreadyExists <- doesDirectoryExist examplesPath
@@ -409,7 +414,8 @@ setup = do
             package = exampleName <> "-" <> showVersion exampleVersion
         case buildTool ?config of
             Cabal -> do
-                callCommand $ "cabal get -v0 " <> package <> " -d " <> examplesPath
+                let cabalVerbosity = "-v" ++ show (fromEnum (verbose ?config))
+                callCommandLogging $ "cabal get " <> cabalVerbosity <> " " <> package <> " -d " <> examplesPath
                 writeFile
                     (path </> "hie.yaml")
                     ("cradle: {cabal: {component: " <> exampleName <> "}}")
@@ -421,7 +427,11 @@ setup = do
                     (path </> "cabal.project.local")
                     ""
             Stack -> do
-                callCommand $ "stack --silent unpack " <> package <> " --to " <> examplesPath
+                let stackVerbosity = case verbosity ?config of
+                        Quiet -> "--silent"
+                        Normal -> ""
+                        All -> "--verbose"
+                callCommandLogging $ "stack " <> stackVerbosity <> " unpack " <> package <> " --to " <> examplesPath
                 -- Generate the stack descriptor to match the one used to build ghcide
                 stack_yaml <- fromMaybe "stack.yaml" <$> getEnv "STACK_YAML"
                 stack_yaml_lines <- lines <$> readFile stack_yaml

From a71cd6799177b69e1ada7a5b41cf1d77c23c7289 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Thu, 31 Dec 2020 11:39:37 +0000
Subject: [PATCH 15/18] [shake-bench] Consolidate -s code

---
 ghcide/bench/lib/Experiments.hs               | 47 ++-----------------
 .../src/Development/Benchmark/Rules.hs        | 43 ++++++++++++++++-
 2 files changed, 47 insertions(+), 43 deletions(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 27a6bcd96c..a6c6817ab5 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -20,12 +20,10 @@ module Experiments
 , exampleToOptions
 ) where
 import Control.Applicative.Combinators (skipManyTill)
-import Control.Concurrent
 import Control.Exception.Safe
 import Control.Monad.Extra
 import Control.Monad.IO.Class
 import Data.Aeson (Value(Null))
-import Data.Char (isDigit)
 import Data.List
 import Data.Maybe
 import qualified Data.Text as T
@@ -245,8 +243,7 @@ runBenchmarksFun dir allBenchmarks = do
         , "userTime"
         , "delayedTime"
         , "totalTime"
-        , "maxResidency"
-        , "allocatedBytes"]
+        ]
       rows =
         [ [ name,
             show success,
@@ -255,9 +252,7 @@ runBenchmarksFun dir allBenchmarks = do
             show runSetup',
             show userWaits,
             show delayedWork,
-            show runExperiment,
-            show maxResidency,
-            show allocations
+            show runExperiment
           ]
           | (Bench {name, samples}, BenchRun {..}) <- results,
             let runSetup' = if runSetup < 0.01 then 0 else runSetup
@@ -277,9 +272,7 @@ runBenchmarksFun dir allBenchmarks = do
             showDuration runSetup',
             showDuration userWaits,
             showDuration delayedWork,
-            showDuration runExperiment,
-            showMB maxResidency,
-            showMB allocations
+            showDuration runExperiment
           ]
           | (Bench {name, samples}, BenchRun {..}) <- results,
             let runSetup' = if runSetup < 0.01 then 0 else runSetup
@@ -325,13 +318,11 @@ data BenchRun = BenchRun
     runExperiment :: !Seconds,
     userWaits :: !Seconds,
     delayedWork :: !Seconds,
-    success :: !Bool,
-    maxResidency :: !Int,
-    allocations :: !Int
+    success :: !Bool
   }
 
 badRun :: BenchRun
-badRun = BenchRun 0 0 0 0 0 False 0 0
+badRun = BenchRun 0 0 0 0 0 False
 
 waitForProgressDone :: Session ()
 waitForProgressDone =
@@ -379,15 +370,6 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
       (runExperiment, result) <- duration $ loop 0 0 samples
       let success = isJust result
           (userWaits, delayedWork) = fromMaybe (0,0) result
-          gcStats = escapeSpaces (name <> ".benchmark-gcStats")
-
-      -- sleep to give ghcide a chance to GC
-      liftIO $ threadDelay 1100000
-
-      (maxResidency, allocations) <- liftIO $
-          ifM (doesFileExist gcStats)
-              (parseMaxResidencyAndAllocations <$> readFile gcStats)
-              (pure (0,0))
 
       return BenchRun {..}
 
@@ -500,30 +482,11 @@ setupDocumentContents config =
 
 --------------------------------------------------------------------------------------------
 
--- Parse the max residency and allocations in RTS -s output
-parseMaxResidencyAndAllocations :: String -> (Int, Int)
-parseMaxResidencyAndAllocations input =
-    (f "maximum residency", f "bytes allocated in the heap")
-  where
-    inps = reverse $ lines input
-    f label = case find (label `isInfixOf`) inps of
-        Just l -> read $ filter isDigit $ head $ words l
-        Nothing -> -1
-
-escapeSpaces :: String -> String
-escapeSpaces = map f
-  where
-    f ' ' = '_'
-    f x = x
-
 pad :: Int -> String -> String
 pad n [] = replicate n ' '
 pad 0 _ = error "pad"
 pad n (x:xx) = x : pad (n-1) xx
 
-showMB :: Int -> String
-showMB x = show (x `div` 2^(20::Int)) <> "MB"
-
 -- | Search for a position where:
 --     - get definition works and returns a uri other than this file
 --     - get completions returns a non empty list
diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs
index 6870aeb85c..a32e97d2a2 100644
--- a/shake-bench/src/Development/Benchmark/Rules.hs
+++ b/shake-bench/src/Development/Benchmark/Rules.hs
@@ -67,7 +67,7 @@ import           Data.Aeson                                (FromJSON (..),
                                                             ToJSON (..),
                                                             Value (..), (.!=),
                                                             (.:?))
-import           Data.List                                 (find, transpose)
+import           Data.List                                 (isInfixOf, find, transpose)
 import           Data.List.Extra                           (lower)
 import           Data.Maybe                                (fromMaybe)
 import           Data.Text                                 (Text)
@@ -88,6 +88,10 @@ import qualified Text.ParserCombinators.ReadP              as P
 import           Text.Read                                 (Read (..), get,
                                                             readMaybe,
                                                             readP_to_Prec)
+import Text.Printf
+import Control.Monad.Extra
+import qualified System.Directory as IO
+import Data.Char (isDigit)
 
 newtype GetExperiments = GetExperiments () deriving newtype (Binary, Eq, Hashable, NFData, Show)
 newtype GetVersions = GetVersions () deriving newtype (Binary, Eq, Hashable, NFData, Show)
@@ -240,6 +244,43 @@ benchRules build benchResource MkBenchRules{..} = do
               BenchProject{..}
           cmd_ Shell $ "mv *.benchmark-gcStats " <> dropFileName outcsv
 
+        -- extend csv output with allocation data
+        csvContents <- liftIO $ lines <$> readFile outcsv
+        let header = head csvContents
+            results = tail csvContents
+            header' = header <> ", maxResidency, allocatedBytes"
+        results' <- forM results $ \row -> do
+            -- assume that the gcStats file can be guessed from the row id
+            -- assume that the row id is the first column
+            let id = takeWhile (/= ',') row
+            let gcStatsPath = dropFileName outcsv </> escapeSpaces id <.> "benchmark-gcStats"
+            (maxResidency, allocations) <- liftIO $
+                ifM (IO.doesFileExist gcStatsPath)
+                    (parseMaxResidencyAndAllocations <$> readFile gcStatsPath)
+                    (pure (0,0))
+            return $ printf "%s, %s, %s" row (showMB maxResidency) (showMB allocations)
+        let csvContents' = header' : results'
+        writeFileLines outcsv csvContents'
+    where
+        escapeSpaces :: String -> String
+        escapeSpaces = map f where
+            f ' ' = '_'
+            f x = x
+
+        showMB :: Int -> String
+        showMB x = show (x `div` 2^(20::Int)) <> "MB"
+
+
+-- Parse the max residency and allocations in RTS -s output
+parseMaxResidencyAndAllocations :: String -> (Int, Int)
+parseMaxResidencyAndAllocations input =
+    (f "maximum residency", f "bytes allocated in the heap")
+  where
+    inps = reverse $ lines input
+    f label = case find (label `isInfixOf`) inps of
+        Just l -> read $ filter isDigit $ head $ words l
+        Nothing -> -1
+
 
 --------------------------------------------------------------------------------
 

From 6f453cbd4dc6c6ea2026014c6f092d3401c7c2f0 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sun, 3 Jan 2021 10:42:44 +0000
Subject: [PATCH 16/18] [bench-hist] Fix: depend on # samples

---
 ghcide/bench/hist/Main.hs                      |  9 +++++++--
 shake-bench/src/Development/Benchmark/Rules.hs | 12 +++++++++---
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/ghcide/bench/hist/Main.hs b/ghcide/bench/hist/Main.hs
index 76b9f46166..5dc4bdad09 100644
--- a/ghcide/bench/hist/Main.hs
+++ b/ghcide/bench/hist/Main.hs
@@ -51,6 +51,7 @@ import Experiments.Types (Example, exampleToOptions)
 import qualified Experiments.Types as E
 import GHC.Generics (Generic)
 import Numeric.Natural (Natural)
+import Development.Shake.Classes
 
 
 config :: FilePath
@@ -70,7 +71,7 @@ main = shakeArgs shakeOptions {shakeChange = ChangeModtimeAndDigest} $ do
       configStatic <- liftIO $ readConfigIO config
       let build = outputFolder configStatic
       buildRules build ghcideBuildRules
-      benchRules build resource (MkBenchRules (benchGhcide $ samples configStatic) "ghcide")
+      benchRules build resource (MkBenchRules (askOracle $ GetSamples ()) benchGhcide "ghcide")
       csvRules build
       svgRules build
       action $ allTargets build
@@ -101,11 +102,15 @@ createBuildSystem userRules = do
   _ <- versioned 1 $ addOracle $ \GetExamples{} -> examples <$> readConfig config
   _ <- versioned 1 $ addOracle $ \(GetExample name) -> find (\e -> getExampleName e == name) . examples <$> readConfig config
   _ <- addOracle $ \GetBuildSystem {} -> buildTool <$> readConfig config
+  _ <- addOracle $ \GetSamples{} -> samples <$> readConfig config
 
   benchResource <- newResource "ghcide-bench" 1
 
   userRules benchResource
 
+newtype GetSamples = GetSamples () deriving newtype (Binary, Eq, Hashable, NFData, Show)
+type instance RuleResult GetSamples = Natural
+
 --------------------------------------------------------------------------------
 
 buildGhcide :: BuildSystem -> [CmdOption] -> FilePath -> Action ()
@@ -130,7 +135,7 @@ buildGhcide Stack args out =
 
 benchGhcide
   :: Natural -> BuildSystem -> [CmdOption] -> BenchProject Example -> Action ()
-benchGhcide samples buildSystem args BenchProject{..} =
+benchGhcide samples buildSystem args BenchProject{..} = do
   command_ args "ghcide-bench" $
     [ "--timeout=3000",
         "-v",
diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs
index a32e97d2a2..2b78fcdac0 100644
--- a/shake-bench/src/Development/Benchmark/Rules.hs
+++ b/shake-bench/src/Development/Benchmark/Rules.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ApplicativeDo     #-}
 {-# LANGUAGE ConstraintKinds     #-}
@@ -198,8 +199,12 @@ buildRules build MkBuildRules{..} = do
         writeFile' ghcPath ghcLoc
 
 --------------------------------------------------------------------------------
-data MkBenchRules buildSystem example = MkBenchRules
-  { benchProject :: buildSystem -> [CmdOption] -> BenchProject example -> Action ()
+data MkBenchRules buildSystem example =  forall setup. MkBenchRules
+  {
+  -- | Workaround for Shake not allowing to call 'askOracle' from 'benchProject
+    setupProject :: Action setup
+  -- | An action that invokes the executable to run the benchmark
+  , benchProject :: setup -> buildSystem -> [CmdOption] -> BenchProject example -> Action ()
   -- | Name of the executable to benchmark. Should match the one used to 'MkBuildRules'
   , executableName :: String
   }
@@ -226,6 +231,7 @@ benchRules build benchResource MkBenchRules{..} = do
         example <- fromMaybe (error $ "Unknown example " <> exampleName)
                     <$> askOracle (GetExample exampleName)
         buildSystem <- askOracle  $ GetBuildSystem ()
+        setupRes    <- setupProject
         liftIO $ createDirectoryIfMissing True $ dropFileName outcsv
         let exePath    = build </> "binaries" </> ver </> executableName
             exeExtraArgs = ["+RTS", "-I0.5", "-S" <> takeFileName outGc, "-RTS"]
@@ -234,7 +240,7 @@ benchRules build benchResource MkBenchRules{..} = do
         need [exePath, ghcPath]
         ghcPath <- readFile' ghcPath
         withResource benchResource 1 $ do
-          benchProject buildSystem
+          benchProject setupRes buildSystem
               [ EchoStdout False,
                 FileStdout outLog,
                 RemEnv "NIX_GHC_LIBDIR",

From 61512b1fff797ccc0d6b9ad384a5d23b35ce1715 Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sun, 3 Jan 2021 23:38:18 +0000
Subject: [PATCH 17/18] [ghcide-bench] cache searchSymbol

---
 ghcide/bench/lib/Experiments.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index a6c6817ab5..7bae8f1657 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -491,7 +491,17 @@ pad n (x:xx) = x : pad (n-1) xx
 --     - get definition works and returns a uri other than this file
 --     - get completions returns a non empty list
 searchSymbol :: TextDocumentIdentifier -> T.Text -> Position -> Session (Maybe Position)
-searchSymbol doc@TextDocumentIdentifier{_uri} fileContents = loop
+searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
+    -- this search is expensive, so we cache the result on disk
+    let cachedPath = fromJust (uriToFilePath _uri) <.> "identifierPosition"
+    cachedRes <- liftIO $ try @_ @IOException $ read <$> readFile cachedPath
+    case cachedRes of
+        Left _ -> do
+            result <- loop pos
+            liftIO $ writeFile cachedPath $ show result
+            return result
+        Right res ->
+            return res
   where
       loop pos
         | _line pos >= lll =

From c687fc16372746fa1d26a696f63253698f83397e Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sat, 9 Jan 2021 08:32:08 +0000
Subject: [PATCH 18/18] [cabal-bench] --no-clean

---
 ghcide/bench/exe/Main.hs        | 9 +++++++--
 ghcide/bench/hist/Main.hs       | 1 +
 ghcide/bench/lib/Experiments.hs | 7 ++++---
 3 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/ghcide/bench/exe/Main.hs b/ghcide/bench/exe/Main.hs
index 141cfc3ad7..ad6460ded2 100644
--- a/ghcide/bench/exe/Main.hs
+++ b/ghcide/bench/exe/Main.hs
@@ -38,17 +38,22 @@ import Control.Exception.Safe
 import Experiments
 import Options.Applicative
 import System.IO
+import           Control.Monad
+
+optsP :: Parser (Config, Bool)
+optsP = (,) <$> configP <*> switch (long "no-clean")
 
 main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
   hSetBuffering stderr LineBuffering
-  config <- execParser $ info (configP <**> helper) fullDesc
+  (config, noClean) <- execParser $ info (optsP <**> helper) fullDesc
   let ?config = config
+
   hPrint stderr config
 
   output "starting test"
 
   SetupResult{..} <- setup
 
-  runBenchmarks experiments `finally` cleanUp
+  runBenchmarks experiments `finally` unless noClean cleanUp
diff --git a/ghcide/bench/hist/Main.hs b/ghcide/bench/hist/Main.hs
index 5dc4bdad09..e9e87693b9 100644
--- a/ghcide/bench/hist/Main.hs
+++ b/ghcide/bench/hist/Main.hs
@@ -138,6 +138,7 @@ benchGhcide
 benchGhcide samples buildSystem args BenchProject{..} = do
   command_ args "ghcide-bench" $
     [ "--timeout=3000",
+      "--no-clean",
         "-v",
         "--samples=" <> show samples,
         "--csv="     <> outcsv,
diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs
index 7bae8f1657..1b4ee3649b 100644
--- a/ghcide/bench/lib/Experiments.hs
+++ b/ghcide/bench/lib/Experiments.hs
@@ -387,14 +387,15 @@ callCommandLogging cmd = do
 
 setup :: HasConfig => IO SetupResult
 setup = do
-  alreadyExists <- doesDirectoryExist examplesPath
-  when alreadyExists $ removeDirectoryRecursive examplesPath
+--   when alreadyExists $ removeDirectoryRecursive examplesPath
   benchDir <- case example ?config of
       UsePackage{..} -> return examplePath
       GetPackage{..} -> do
         let path = examplesPath </> package
             package = exampleName <> "-" <> showVersion exampleVersion
-        case buildTool ?config of
+        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