diff --git a/ghcide/bench/config.yaml b/ghcide/bench/config.yaml index 705599bb9a..68cef76e51 100644 --- a/ghcide/bench/config.yaml +++ b/ghcide/bench/config.yaml @@ -28,8 +28,6 @@ examples: modules: - hls-plugin-api/src/Ide/Plugin/Config.hs - ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs - - ghcide/bench/hist/Main.hs - - ghcide/bench/lib/Experiments/Types.hs - ghcide/test/exe/Main.hs - exe/Plugins.hs diff --git a/ghcide/bench/hist/Main.hs b/ghcide/bench/hist/Main.hs index 0de9f6296a..a76a18374f 100644 --- a/ghcide/bench/hist/Main.hs +++ b/ghcide/bench/hist/Main.hs @@ -56,6 +56,8 @@ import System.Console.GetOpt import Data.Maybe import Control.Monad.Extra import System.FilePath +import System.Directory as IO +import System.IO.Extra configPath :: FilePath @@ -138,20 +140,32 @@ type instance RuleResult GetSamples = Natural -------------------------------------------------------------------------------- -buildGhcide :: BuildSystem -> [CmdOption] -> FilePath -> Action () -buildGhcide Cabal args out = do - command_ args "cabal" +buildGhcide + :: BuildSystem + -> Maybe FilePath -- ^ working directory + -> FilePath -- ^ output folder + -> Action () +buildGhcide Cabal cwd out = do + let cabalLocal = fromMaybe ".." cwd "cabal.project.local" + previousValue <- liftIO $ do + itExisted <- IO.doesFileExist cabalLocal + whenMaybe itExisted $ System.IO.Extra.readFile' cabalLocal + liftIO $ writeFile cabalLocal $ unlines + [ "package ghcide" + , " ghc-options: -eventlog -rtsopts"] + command_ (maybe [] (pure . Cwd) cwd) "cabal" ["install" ,"exe:ghcide" ,"--installdir=" ++ out ,"--install-method=copy" ,"--overwrite-policy=always" - ,"--ghc-options=-rtsopts" - ,"--ghc-options=-eventlog" ] + `actionFinally` do + liftIO $ removeFile cabalLocal + liftIO $ whenJust previousValue $ writeFile cabalLocal -buildGhcide Stack args out = - command_ args "stack" +buildGhcide Stack cwd out = + command_ (maybe [] (pure . Cwd) cwd) "stack" ["--local-bin-path=" <> out ,"build" ,"ghcide:ghcide" @@ -181,7 +195,8 @@ benchGhcide samples buildSystem args BenchProject{..} = do warmupGhcide :: BuildSystem -> FilePath -> [CmdOption] -> Example -> Action () warmupGhcide buildSystem exePath args example = do command args "ghcide-bench" $ - [ "--no-clean", + [ "--timeout=300", + "--no-clean", "-v", "--samples=1", "--ghcide=" <> exePath, diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 60435ffe25..8953425ddf 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -171,17 +171,18 @@ phonyRules prefix executableName prof buildFolder examples = do phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName -------------------------------------------------------------------------------- type OutputFolder = FilePath +type CWD = FilePath data MkBuildRules buildSystem = MkBuildRules { -- | Return the path to the GHC executable to use for the project found in the cwd - findGhc :: buildSystem -> FilePath -> IO FilePath + findGhc :: buildSystem -> Maybe CWD -> IO FilePath -- | Name of the binary produced by 'buildProject' , executableName :: String -- | An action that captures the source dependencies, used for the HEAD build , projectDepends :: Action () -- | Build the project found in the cwd and save the build artifacts in the output folder , buildProject :: buildSystem - -> [CmdOption] + -> Maybe CWD -> OutputFolder -> Action () } @@ -209,8 +210,8 @@ buildRules build MkBuildRules{..} = do projectDepends liftIO $ createDirectoryIfMissing True $ dropFileName out buildSystem <- askOracle $ GetBuildSystem () - buildProject buildSystem [Cwd "."] (takeDirectory out) - ghcLoc <- liftIO $ findGhc buildSystem "." + buildProject buildSystem Nothing (takeDirectory out) + ghcLoc <- liftIO $ findGhc buildSystem Nothing writeFile' ghcpath ghcLoc -- build rules for non HEAD revisions @@ -223,8 +224,8 @@ buildRules build MkBuildRules{..} = do cmd_ $ "git worktree add bench-temp-" ++ ver ++ " " ++ commitid buildSystem <- askOracle $ GetBuildSystem () flip actionFinally (cmd_ ("git worktree remove bench-temp-" <> ver <> " --force" :: String)) $ do - ghcLoc <- liftIO $ findGhc buildSystem ver - buildProject buildSystem [Cwd $ "bench-temp-" <> ver] (".." takeDirectory out) + ghcLoc <- liftIO $ findGhc buildSystem (Just ver) + buildProject buildSystem (Just $ "bench-temp-" <> ver) (".." takeDirectory out) writeFile' ghcPath ghcLoc -------------------------------------------------------------------------------- @@ -461,11 +462,11 @@ data BuildSystem = Cabal | Stack deriving (Eq, Read, Show, Generic) deriving (Binary, Hashable, NFData) -findGhcForBuildSystem :: BuildSystem -> FilePath -> IO FilePath +findGhcForBuildSystem :: BuildSystem -> Maybe FilePath -> IO FilePath findGhcForBuildSystem Cabal _cwd = liftIO $ fromMaybe (error "ghc is not in the PATH") <$> findExecutable "ghc" findGhcForBuildSystem Stack cwd = do - Stdout ghcLoc <- cmd [Cwd cwd] ("stack exec which ghc" :: String) + Stdout ghcLoc <- cmd (maybe [] (pure . Cwd) cwd) ("stack exec which ghc" :: String) return ghcLoc instance FromJSON BuildSystem where