ghc-bench 0.3.1 → 0.3.2

raw patch · 4 files changed

+61/−16 lines, 4 files

Files

• ghc-bench.cabal +1/−1
• src/Result.hs +9/−4
• src/Run.hs +42/−10
• test/RunSpec.hs +9/−1

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

@@ -20,6 +20,7 @@ import Prelude qualified  import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.ByteString.Char8 (ByteString, putStrLn) import System.FilePath (joinPath) import Network.HTTP.Types.URI (renderSimpleQuery)@@ -36,10 +37,14 @@ , system :: SystemInfo } deriving (Eq, Show, Generic) -submit :: Result -> IO ()-submit result = do-  putStrLn "Open this URL to submit your result:"-  putStrLn $ "\n  " <> issueUrl result+submit :: Result -> (Maybe (FilePath -> IO ())) -> IO ()+submit (issueUrl -> url) = \ case+  Nothing -> do+    putStrLn "Open this URL to submit your result:\n"+    putStrLn $ "  " <> url+  Just qrencode -> do+    putStrLn "Open this URL to submit your result:\n"+    qrencode (unpack $ T.decodeUtf8Lenient url)  issueUrl :: Result -> ByteString issueUrl result = base <> renderQuery [

@@ -1,5 +1,12 @@-module Run (main, run) where+module Run (+  main +, DryRun(..)+, PrintQR(..)+, parseOptions+, run+) where+ import Imports  import Data.List qualified as List@@ -43,17 +50,42 @@ ghciPackage :: FilePath ghciPackage = "containers-0.8" -parseOptions :: [FilePath] -> (Bool, [FilePath])-parseOptions = first (not . null) . List.partition (== "--dry-run")+data DryRun = NoDryRun | DryRun+  deriving (Eq, Show, Bounded) +data PrintQR = NoPrintQR | PrintQR+  deriving (Eq, Show, Bounded)++parseOptions :: [FilePath] -> (DryRun, (PrintQR, [FilePath]))+parseOptions = fmap parsePrintQR . parseDryRun++parseDryRun :: [FilePath] -> (DryRun, [FilePath])+parseDryRun = parseOption "dry-run"++parsePrintQR :: [FilePath] -> (PrintQR, [FilePath])+parsePrintQR = parseOption "qr"++parseOption :: Bounded a => String -> [String] -> (a, [String])+parseOption name = List.partition (== "--" <> name) >>> first \ case+  [] -> minBound+  _ -> maxBound+ main :: [String] -> IO ()-main (parseOptions -> (dryRun, args)) = do+main (parseOptions -> (dryRun, (printQR, args))) = do    cacheDir <- getXdgDirectory XdgCache "ghc-bench"   createDirectoryIfMissing True cacheDir   baseDir <- getTemporaryDirectory <&> (</> "ghc-bench")   createDirectoryIfMissing False baseDir +  qrencode <- case printQR of+    NoPrintQR -> do+      return Nothing+    PrintQR -> do+      let command = "qrencode"+      Command.require command+      return $ Just (\ url -> Command.call command ["-t", "ANSIUTF8", url])+   Blob.requireAll   SystemInfo.requireAll   stage0 <- Command.resolve ghc@@ -69,11 +101,11 @@       putStrLn $ "  " <> name <> ": " <> (Result.formatTime time)      putStrLn ""-    Result.submit Result {..}+    Result.submit Result {..} qrencode  type WithTempDirectory = forall a. (FilePath -> IO a) -> IO a -run :: FilePath -> WithTempDirectory -> Bool -> [String] -> FilePath -> Concurrency -> IO [(Label, Seconds)]+run :: FilePath -> WithTempDirectory -> DryRun -> [String] -> FilePath -> Concurrency -> IO [(Label, Seconds)] run cacheDir withTemp dryRun args stage0 concurrency = requireDependencies >> case args of   [] -> runAll   [name] | Just action <- lookup name actions -> action@@ -104,7 +136,7 @@     usage :: FilePath     usage = "\nusage: ghc-bench [ " <> List.intercalate " | " (map fst actions) <> " ] [ --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+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

@@ -5,10 +5,18 @@ import README (ensureFile)  import Run qualified+import Run (DryRun(..), PrintQR(..))  spec :: Spec spec = do   describe "--dry-run" do     it "prints commands" do-      let run = Run.run "~/.cache/ghc-bench" ($ "<sandbox>") True [] "/path/to/ghc-9.12.4" 20+      let run = Run.run "~/.cache/ghc-bench" ($ "<sandbox>") DryRun [] "/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"]))++    it "accepts --qr" do+      Run.parseOptions ["--qr", "foo", "bar"] `shouldBe` (NoDryRun, (PrintQR, ["foo", "bar"]))