ghc-bench-0.3.0: src/Run.hs

module Run (main, run) where

import Imports

import Data.List qualified as List
import Data.Text.IO (putStrLn)
import System.Directory (createDirectoryIfMissing)
import System.Exit (die)

import Command (Concurrency, nproc)
import Command qualified
import SystemInfo qualified
import Blob (Blob(..))
import Result (Result(..), Label(..), Seconds)
import Result qualified
import Benchmark.Type (Benchmark, withLabel)
import Benchmark.Type qualified as Benchmark
import Benchmark.BuildGhc (Tarball(..))
import Benchmark.BuildGhc qualified as BuildGhc
import Benchmark.BuildCabalPackage qualified as BuildCabalPackage
import Benchmark.Ghci qualified as Ghci

version :: FilePath
version = "9.12.4"

ghc :: FilePath
ghc = "ghc-" <> version

baseDir :: FilePath
baseDir = "/tmp/ghc-bench"

sourceTarball :: Tarball
sourceTarball = Tarball {
    blob = Blob {
      url = "https://downloads.haskell.org/~ghc/" <> version <> "/ghc-" <> version <> "-src.tar.gz"
    , path = baseDir </> "ghc-" <> version <> "-src.tar.gz"
    , hash = "df71d96169056d3a6d7ec17498864cbdd5511bda196440dc38a692133833dfa4"
    }
  , root = "ghc-" <> version
  }

cabalPackage :: FilePath
cabalPackage = "hedgehog-1.7"

ghciPackage :: FilePath
ghciPackage = "containers-0.8"

parseOptions :: [FilePath] -> (Bool, [FilePath])
parseOptions = first (not . null) . List.partition (== "--dry-run")

main :: [String] -> IO ()
main (parseOptions -> (dryRun, args)) = do
  Command.requireAll
  stage0 <- Command.resolve ghc
  createDirectoryIfMissing False baseDir
  system <- SystemInfo.collect
  concurrency <- nproc
  times <- run (withTempDirectory baseDir "build") dryRun args stage0 concurrency
  unless (null times) do
    putStrLn "\ntimes:"
    for_ times \ (Label name, time) -> do
      putStrLn $ "  " <> name <> ": " <> (Result.formatTime time)

    putStrLn ""
    Result.submit Result {..}

type WithTempDirectory = forall a. (FilePath -> IO a) -> IO a

run :: WithTempDirectory -> Bool -> [String] -> FilePath -> Concurrency -> IO [(Label, Seconds)]
run withTemp dryRun args stage0 concurrency = requireDependencies >> case args of
  [] -> runAll
  [name] | Just action <- lookup name subcommands -> action
  _ -> die usage
  where
    requireDependencies :: IO ()
    requireDependencies = for_ dependencies Command.require

    dependencies :: [FilePath]
    dependencies = List.nub $ concatMap (Benchmark.dependencies . snd) benchmarkActions

    benchmarkActions :: [(String, Benchmark ())]
    benchmarkActions = [
        ("ghc", withLabel ghc $ BuildGhc.run sourceTarball stage0 concurrency)
      , ("cabal", withLabel cabalPackage $ BuildCabalPackage.run cabalPackage ghc concurrency)
      , ("ghci", withLabel ghciPackage $ Ghci.run ghciPackage ghc concurrency)
      ]

    runAll :: IO [(Label, Seconds)]
    runAll = concat <$> sequence (map snd actions)

    actions :: [(String, IO [(Label, Seconds)])]
    actions = map (fmap $ withTemp . runBenchmark dryRun) benchmarkActions

    subcommands :: [(FilePath, IO [(Label, Seconds)])]
    subcommands = actions ++ [
        ("all", runAll)
      , ("info", return [("info", 0)])
      ]

    usage :: FilePath
    usage = "usage: ghc-bench [ " <> List.intercalate " | " (map fst subcommands) <> " ] [ --dry-run ]"

runBenchmark :: Bool -> Benchmark () -> FilePath -> IO [(Label, Seconds)]
runBenchmark dryRun action dir
  | dryRun = Benchmark.dryRun $ Benchmark.cd dir action
  | otherwise = Benchmark.run $ Benchmark.cd dir action