Only read stdout when running with --more-verbose

When not running with `-V` or `--more-verbose`, we now pipe the stdout
of the executable under test to /dev/null. This prevents quickbench from
running out of memory in case the output is huge (GBs).

MINOR REMARK

With my version of GHC (9.6.6), all exceptions unfortunately get annoted
`withBinaryFile`, see https://gitlab.haskell.org/ghc/ghc/-/issues/20886.

For example, when running `quickbench -w doesnotexist`, the error
message is:

```
/dev/null: withBinaryFile: does not exist (No such file or directory)
```

When running `quickbench -w doesnotexist --more-verbose`, avoiding the
call to `withBinaryFile`, the error message is the much clearer:

```
doesnotexist: readCreateProcess: posix_spawnp: does not exist (No such file or directory)
```

This is not ideal, but I believe using the latest version of GHC will
fix it.

Author: thomie

src/QuickBench.hs

@@ -13,12 +13,14 @@ import Data.Maybe
 import Data.Time.Clock
 import Data.Time.Format
 import Data.Time.LocalTime
+import GHC.IO.Exception (IOErrorType(..))
 import Safe
 import System.Console.Docopt
 import System.Directory
 import System.Environment
 import System.Exit
 import System.IO
+import System.IO.Error (mkIOError)
 import System.Process
 import Text.Show.Pretty
 import Text.Printf
@@ -198,17 +200,31 @@ replaceExecutable exe cmd = (unwords (exe:args), exe, args) where args = drop 1
 time :: Opts -> String -> [String] -> IO Float
 time opts exe args = do
   t1 <- getCurrentTime
-  (c, o, e) <- readProcessWithExitCode' exe args ""
+  maybeOutput <- if (moreVerbose opts)
+    then Just <$> readCreateProcess (proc exe args) ""
+    else const Nothing <$> callProcessIgnoreOutput exe args
   t2 <- getCurrentTime
-  when (not $ null o) $ outvv opts $ (if verbose opts then "\n" else "") ++ o
-  unless (c == ExitSuccess) $ out opts $ " (error: " ++ clean e ++ ") "
+  case maybeOutput of
+    Just o -> when (not $ null o) $ outvv opts $ (if verbose opts then "\n" else "") ++ o
+    Nothing -> return ()
   return $ realToFrac $ diffUTCTime t2 t1
 
--- ^ This variant also returns a failure when the executable is missing.
-readProcessWithExitCode' :: FilePath -> [String] -> String -> IO (ExitCode, String, String)
-readProcessWithExitCode' exe args inp =
-  readProcessWithExitCode exe args inp
-    `catch` \(e :: IOException) -> return (ExitFailure 1, "", show e)
+callProcessIgnoreOutput :: FilePath -> [String] -> IO ()
+callProcessIgnoreOutput cmd args =
+  withBinaryFile "/dev/null" WriteMode $ \devNull ->
+    withCreateProcess (proc cmd args){std_out = UseHandle devNull} $ \_ _ _ ph -> do
+      exit_code <- waitForProcess ph
+      case exit_code of
+        ExitSuccess   -> return ()
+        ExitFailure r -> processFailedException "callProcessIgnoreOutput" cmd args r
+
+-- Copy/paste from "process" System.Process.
+processFailedException :: String -> String -> [String] -> Int -> IO a
+processFailedException fun cmd args exit_code =
+      ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++
+                                     concatMap ((' ':) . show) args ++
+                                     " (exit " ++ show exit_code ++ ")")
+                                 Nothing Nothing)
 
 printSummary :: Opts -> [String] -> [String] -> Int -> [[[Float]]] -> IO ()
 printSummary opts cmds exes cyc results = do