[ghcide-bench] Support extra args in examples (#2107)

* [ghcide-bench] Support extra args in examples

This is useful in the context of #2060 to compare performance with and
without reactive change tracking

* Fix bench.yml CI script

Author: pepeiborra

.github/workflows/bench.yml

@@ -108,7 +108,7 @@ jobs:
       matrix:
         ghc: ['8.10.4']
         os: [ubuntu-latest]
-        example: ['Cabal-3.0.0.0', 'lsp-types-1.0.0.1']
+        example: ['cabal', 'lsp-types']
 
     steps:
     - if: ${{ needs.pre_job.outputs.should_skip != 'true' }}

ghcide/bench/config.yaml

@@ -12,20 +12,25 @@ outputFolder: bench-results
 # or a local project (path) with a valid `hie.yaml` file
 examples:
   # Medium-sized project without TH
-  - name: Cabal
+  - name: cabal
+    package: Cabal
     version: 3.0.0.0
     modules:
         - Distribution/Simple.hs
         - Distribution/Types/Module.hs
+    extra-args: [] # extra ghcide command line args
   # Small-sized project with TH
   - name: lsp-types
+    package: lsp-types
     version: 1.0.0.1
     modules:
         - src/Language/LSP/VFS.hs
         - src/Language/LSP/Types/Lens.hs
+    extra-args: [] # extra ghcide command line args
   # Small but heavily multi-component example
   # Disabled as it is far to slow. hie-bios >0.7.2 should help
-  # - path: bench/example/HLS
+  # - name: HLS
+  #   path: bench/example/HLS
   #   modules:
   #       - hls-plugin-api/src/Ide/Plugin/Config.hs
   #       - ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs

ghcide/bench/hist/Main.hs

@@ -50,8 +50,8 @@ import           Data.Yaml                   (FromJSON (..), decodeFileThrow)
 import           Development.Benchmark.Rules
 import           Development.Shake
 import           Development.Shake.Classes
-import           Experiments.Types           (Example, exampleToOptions)
-import qualified Experiments.Types           as E
+import           Experiments.Types           (Example (exampleName),
+                                              exampleToOptions)
 import           GHC.Generics                (Generic)
 import           Numeric.Natural             (Natural)
 import           System.Console.GetOpt
@@ -68,7 +68,7 @@ configOpt = Option [] ["config"] (ReqArg Right configPath) "config file"
 readConfigIO :: FilePath -> IO (Config BuildSystem)
 readConfigIO = decodeFileThrow
 
-instance IsExample Example where getExampleName = E.getExampleName
+instance IsExample Example where getExampleName = exampleName
 type instance RuleResult GetExample = Maybe Example
 type instance RuleResult GetExamples = [Example]
 
@@ -170,11 +170,10 @@ benchGhcide samples buildSystem args BenchProject{..} = do
         "--samples=" <> show samples,
         "--csv="     <> outcsv,
         "--ghcide="  <> exePath,
-        "--ghcide-options=" <> unwords exeExtraArgs,
         "--select",
         unescaped (unescapeExperiment experiment)
     ] ++
-    exampleToOptions example ++
+    exampleToOptions example exeExtraArgs ++
     [ "--stack" | Stack == buildSystem
     ]
 
@@ -187,6 +186,6 @@ warmupGhcide buildSystem exePath args example = do
       "--ghcide=" <> exePath,
       "--select=hover"
     ] ++
-    exampleToOptions example ++
+    exampleToOptions example [] ++
     [ "--stack" | Stack == buildSystem
     ]

ghcide/bench/lib/Experiments.hs

@@ -239,16 +239,23 @@ configP =
     <*> optional (option auto (long "samples" <> metavar "NAT" <> help "override sampling count"))
     <*> 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")
+    <*> ( Example "name"
+               <$> (Right <$> packageP)
                <*> (some moduleOption <|> pure ["Distribution/Simple.hs"])
-               <*> option versionP (long "example-package-version" <> value (makeVersion [3,4,0,0]))
+               <*> pure []
          <|>
-          UsePackage <$> strOption (long "example-path")
-                     <*> some moduleOption
-         )
+          Example "name"
+                <$> (Left <$> pathP)
+                <*> some moduleOption
+                <*> pure [])
   where
       moduleOption = strOption (long "example-module" <> metavar "PATH")
 
+      packageP = ExamplePackage
+            <$> strOption (long "example-package-name" <> value "Cabal")
+            <*> option versionP (long "example-package-version" <> value (makeVersion [3,4,0,0]))
+      pathP = strOption (long "example-path")
+
 versionP :: ReadM Version
 versionP = maybeReader $ extract . readP_to_S parseVersion
   where
@@ -472,16 +479,16 @@ callCommandLogging cmd = do
 setup :: HasConfig => IO SetupResult
 setup = do
 --   when alreadyExists $ removeDirectoryRecursive examplesPath
-  benchDir <- case example ?config of
-      UsePackage{..} -> do
+  benchDir <- case exampleDetails(example ?config) of
+      Left examplePath -> do
           let hieYamlPath = examplePath </> "hie.yaml"
           alreadyExists <- doesFileExist hieYamlPath
           unless alreadyExists $
                 cmd_ (Cwd examplePath) (FileStdout hieYamlPath) ("gen-hie"::String)
           return examplePath
-      GetPackage{..} -> do
+      Right ExamplePackage{..} -> do
         let path = examplesPath </> package
-            package = exampleName <> "-" <> showVersion exampleVersion
+            package = packageName <> "-" <> showVersion packageVersion
             hieYamlPath = path </> "hie.yaml"
         alreadySetup <- doesDirectoryExist path
         unless alreadySetup $
@@ -524,9 +531,9 @@ setup = do
 
   whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True
 
-  let cleanUp = case example ?config of
-        GetPackage{} -> removeDirectoryRecursive examplesPath
-        UsePackage{} -> return ()
+  let cleanUp = case exampleDetails(example ?config) of
+        Right _ -> removeDirectoryRecursive examplesPath
+        Left _  -> return ()
 
       runBenchmarks = runBenchmarksFun benchDir
 

ghcide/bench/lib/Experiments/Types.hs

@@ -4,11 +4,11 @@
 module Experiments.Types (module Experiments.Types ) where
 
 import           Data.Aeson
+import           Data.Maybe                (fromMaybe)
 import           Data.Version
 import           Development.Shake.Classes
 import           GHC.Generics
 import           Numeric.Natural
-import           System.FilePath           (isPathSeparator)
 
 data CabalStack = Cabal | Stack
   deriving (Eq, Show)
@@ -31,40 +31,44 @@ data Config = Config
   }
   deriving (Eq, Show)
 
-data Example
-    = GetPackage {exampleName :: !String, exampleModules :: [FilePath], exampleVersion :: Version}
-    | UsePackage {examplePath :: FilePath, exampleModules :: [FilePath]}
+data ExamplePackage = ExamplePackage {packageName :: !String, packageVersion :: !Version}
   deriving (Eq, Generic, Show)
   deriving anyclass (Binary, Hashable, NFData)
 
-getExampleName :: Example -> String
-getExampleName UsePackage{examplePath} = map replaceSeparator examplePath
-  where
-      replaceSeparator x
-        | isPathSeparator x = '_'
-        | otherwise = x
-getExampleName GetPackage{exampleName, exampleVersion} =
-    exampleName <> "-" <> showVersion exampleVersion
+data Example = Example
+    { exampleName      :: !String
+    , exampleDetails   :: Either FilePath ExamplePackage
+    , exampleModules   :: [FilePath]
+    , exampleExtraArgs :: [String]}
+  deriving (Eq, Generic, Show)
+  deriving anyclass (Binary, Hashable, NFData)
 
 instance FromJSON Example where
     parseJSON = withObject "example" $ \x -> do
+        exampleName <- x .: "name"
         exampleModules <- x .: "modules"
+        exampleExtraArgs <- fromMaybe [] <$> x .:? "extra-args"
 
         path <- x .:? "path"
         case path of
-            Just examplePath -> return UsePackage{..}
+            Just examplePath -> do
+                let exampleDetails = Left examplePath
+                return Example{..}
             Nothing -> do
-                exampleName <- x .: "name"
-                exampleVersion <- x .: "version"
-                return GetPackage {..}
+                packageName <- x .: "package"
+                packageVersion <- x .: "version"
+                let exampleDetails = Right ExamplePackage{..}
+                return Example{..}
 
-exampleToOptions :: Example -> [String]
-exampleToOptions GetPackage{..} =
-    ["--example-package-name", exampleName
-    ,"--example-package-version", showVersion exampleVersion
+exampleToOptions :: Example -> [String] -> [String]
+exampleToOptions Example{exampleDetails = Right ExamplePackage{..}, ..} extraArgs =
+    ["--example-package-name", packageName
+    ,"--example-package-version", showVersion packageVersion
+    ,"--ghcide-options", unwords $ exampleExtraArgs ++ extraArgs
     ] ++
     ["--example-module=" <> m | m <- exampleModules]
-exampleToOptions UsePackage{..} =
+exampleToOptions Example{exampleDetails = Left examplePath, ..} extraArgs =
     ["--example-path", examplePath
+    ,"--ghcide-options", unwords $ exampleExtraArgs ++ extraArgs
     ] ++
     ["--example-module=" <> m | m <- exampleModules]