ghc-bench 0.3.2 → 0.3.3

raw patch · 4 files changed

+43/−17 lines, 4 files

Files

• ghc-bench.cabal +1/−1
• src/Benchmark/Type.hs +12/−0
• src/Run.hs +20/−12
• test/RunSpec.hs +10/−4

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           ghc-bench-version:        0.3.2+version:        0.3.3 synopsis:       Benchmark a Haskell development system description:    See the README at <https://github.com/sol/ghc-bench#readme> category:       Development

@@ -4,6 +4,7 @@ , Benchmark , dependencies , dryRun+, prepare , run  , withLabel@@ -55,6 +56,9 @@   Utf8.putStrLn output   return times +prepare :: Benchmark () -> IO [(Label, Seconds)]+prepare = execForest . dropMeasuredCommands . toForest+ run :: Benchmark () -> IO [(Label, Seconds)] run = execForest . toForest @@ -151,6 +155,14 @@ showArg arg   | any isSpace arg = show arg   | otherwise = pack arg++dropMeasuredCommands :: [Command] -> [Command]+dropMeasuredCommands = map \ case+  SetEnv name value commands -> SetEnv name value (dropMeasuredCommands commands)+  ChangeDirectory dir commands -> ChangeDirectory dir (dropMeasuredCommands commands)+  Download blob -> Download blob+  Call command args -> Call command args+  Measure label _ -> Measure label []  execForest :: [Command] -> IO [(Label, Seconds)] execForest = go mempty

@@ -2,6 +2,7 @@   main  , DryRun(..)+, Prepare(..) , PrintQR(..) , parseOptions , run@@ -53,15 +54,21 @@ data DryRun = NoDryRun | DryRun   deriving (Eq, Show, Bounded) +data Prepare = NoPrepare | Prepare+  deriving (Eq, Show, Bounded)+ data PrintQR = NoPrintQR | PrintQR   deriving (Eq, Show, Bounded) -parseOptions :: [FilePath] -> (DryRun, (PrintQR, [FilePath]))-parseOptions = fmap parsePrintQR . parseDryRun+parseOptions :: [FilePath] -> (DryRun, (Prepare, (PrintQR, [FilePath])))+parseOptions = (fmap . fmap) parsePrintQR . fmap parsePrepare . parseDryRun  parseDryRun :: [FilePath] -> (DryRun, [FilePath]) parseDryRun = parseOption "dry-run" +parsePrepare :: [FilePath] -> (Prepare, [FilePath])+parsePrepare = parseOption "prepare"+ parsePrintQR :: [FilePath] -> (PrintQR, [FilePath]) parsePrintQR = parseOption "qr" @@ -71,7 +78,7 @@   _ -> maxBound  main :: [String] -> IO ()-main (parseOptions -> (dryRun, (printQR, args))) = do+main (parseOptions -> (dryRun, (prepare, (printQR, args)))) = do    cacheDir <- getXdgDirectory XdgCache "ghc-bench"   createDirectoryIfMissing True cacheDir@@ -94,7 +101,7 @@    putStr . unlines $ "" : SystemInfo.pretty system -  times <- run cacheDir (withTempDirectory baseDir "build") dryRun args stage0 concurrency+  times <- run cacheDir (withTempDirectory baseDir "build") dryRun prepare args stage0 concurrency   unless (null times) do     putStrLn "\ntimes:"     for_ times \ (Label name, time) -> do@@ -105,8 +112,8 @@  type WithTempDirectory = forall a. (FilePath -> IO a) -> IO a -run :: FilePath -> WithTempDirectory -> DryRun -> [String] -> FilePath -> Concurrency -> IO [(Label, Seconds)]-run cacheDir withTemp dryRun args stage0 concurrency = requireDependencies >> case args of+run :: FilePath -> WithTempDirectory -> DryRun -> Prepare -> [String] -> FilePath -> Concurrency -> IO [(Label, Seconds)]+run cacheDir withTemp dryRun prepare args stage0 concurrency = requireDependencies >> case args of   [] -> runAll   [name] | Just action <- lookup name actions -> action   _ -> die usage@@ -131,12 +138,13 @@     runAll = concat <$> sequence (map snd actions)      actions :: [(String, IO [(Label, Seconds)])]-    actions = map (fmap $ withTemp . runBenchmark dryRun) benchmarkActions+    actions = map (fmap $ withTemp . runBenchmark dryRun prepare) benchmarkActions      usage :: FilePath-    usage = "\nusage: ghc-bench [ " <> List.intercalate " | " (map fst actions) <> " ] [ --dry-run ]"+    usage = "\nusage: ghc-bench [ " <> List.intercalate " | " (map fst actions) <> " ] [ --dry-run ] [ --prepare ]" -runBenchmark :: DryRun -> Benchmark () -> FilePath -> IO [(Label, Seconds)]-runBenchmark dryRun action dir = case dryRun of-  NoDryRun -> Benchmark.run $ Benchmark.cd dir action-  DryRun -> Benchmark.dryRun $ Benchmark.cd dir action+runBenchmark :: DryRun -> Prepare -> Benchmark () -> FilePath -> IO [(Label, Seconds)]+runBenchmark dryRun prepare action dir = case (dryRun, prepare) of+  (DryRun, _) -> Benchmark.dryRun $ Benchmark.cd dir action+  (_, Prepare) -> Benchmark.prepare $ Benchmark.cd dir action+  _ -> Benchmark.run $ Benchmark.cd dir action

@@ -5,18 +5,24 @@ import README (ensureFile)  import Run qualified-import Run (DryRun(..), PrintQR(..))+import Run (DryRun(..), Prepare(..), PrintQR(..))  spec :: Spec spec = do   describe "--dry-run" do     it "prints commands" do-      let run = Run.run "~/.cache/ghc-bench" ($ "<sandbox>") DryRun [] "/path/to/ghc-9.12.4" 20+      let run = Run.run "~/.cache/ghc-bench" ($ "<sandbox>") DryRun NoPrepare [] "/path/to/ghc-9.12.4" 20       capture_ run >>= ensureFile "test/dry-run" . encodeUtf8 . pack    describe "parseOptions" do     it "accepts --dry-run" do-      Run.parseOptions ["--dry-run", "foo", "bar"] `shouldBe` (DryRun, (NoPrintQR, ["foo", "bar"]))+      Run.parseOptions ["--dry-run", "foo", "bar"]+        `shouldBe` (DryRun, (NoPrepare, (NoPrintQR, ["foo", "bar"]))) +    it "accepts --prepare" do+      Run.parseOptions ["--prepare", "foo", "bar"]+        `shouldBe` (NoDryRun, (Prepare, (NoPrintQR, ["foo", "bar"])))+     it "accepts --qr" do-      Run.parseOptions ["--qr", "foo", "bar"] `shouldBe` (NoDryRun, (PrintQR, ["foo", "bar"]))+      Run.parseOptions ["--qr", "foo", "bar"]+        `shouldBe` (NoDryRun, (NoPrepare, (PrintQR, ["foo", "bar"])))