Add exec variant that allows a negative call

src/Hedgehog/Extras/Test/Process.hs

@@ -6,9 +6,11 @@
 module Hedgehog.Extras.Test.Process
   ( createProcess
   , exec
+  , execAny
   , exec_
   , execFlex
   , execFlex'
+  , execFlexAny'
   , procFlex
   , binFlex
 
@@ -43,7 +45,7 @@ import           Hedgehog (MonadTest)
 import           Hedgehog.Extras.Internal.Cli (argQuote)
 import           Hedgehog.Extras.Internal.Plan (Component (..), Plan (..))
 import           Hedgehog.Extras.Stock.IO.Process (TimedOut (..))
-import           Prelude (error)
+import           Prelude (error, (++))
 import           System.Exit (ExitCode)
 import           System.FilePath (takeDirectory)
 import           System.FilePath.Posix ((</>))
@@ -164,27 +166,36 @@ execFlex'
   -> [String]
   -> m String
 execFlex' execConfig pkgBin envBin arguments = GHC.withFrozenCallStack $ do
-  cp <- procFlex' execConfig pkgBin envBin arguments
-  H.annotate . ("Command: " <>) $ case IO.cmdspec cp of
-    IO.ShellCommand cmd -> cmd
-    IO.RawCommand cmd args -> cmd <> " " <> L.unwords args
-  (exitResult, stdout, stderr) <- H.evalIO $ IO.readCreateProcessWithExitCode cp ""
+  (exitResult, stdout, stderr) <- execFlexAny' execConfig pkgBin envBin arguments
   case exitResult of
     IO.ExitFailure exitCode -> do
       H.annotate $ L.unlines $
-        [ "Process exited with non-zero exit-code"
+        [ "Process exited with non-zero exit-code: " ++ show @Int exitCode
         , "━━━━ command ━━━━"
         , pkgBin <> " " <> L.unwords (fmap argQuote arguments)
-        , "━━━━ stdout ━━━━"
-        , stdout
-        , "━━━━ stderr ━━━━"
-        , stderr
-        , "━━━━ exit code ━━━━"
-        , show @Int exitCode
         ]
+        ++ if L.null stdout then [] else ["━━━━ stdout ━━━━" , stdout]
+        ++ if L.null stderr then [] else ["━━━━ stderr ━━━━" , stderr]
       H.failMessage GHC.callStack "Execute process failed"
     IO.ExitSuccess -> return stdout
 
+-- | Run a process, returning its exit code, its stdout, and its stderr.
+-- Contrary to @execFlex'@, this function doesn't fail if the call fails.
+-- So, if you want to test something negative, this is the function to use.
+execFlexAny'
+  :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
+  => ExecConfig
+  -> String
+  -> String
+  -> [String]
+  -> m (ExitCode, String, String)
+execFlexAny' execConfig pkgBin envBin arguments = GHC.withFrozenCallStack $ do
+  cp <- procFlex' execConfig pkgBin envBin arguments
+  H.annotate . ("Command: " <>) $ case IO.cmdspec cp of
+    IO.ShellCommand cmd -> cmd
+    IO.RawCommand cmd args -> cmd <> " " <> L.unwords args
+  H.evalIO $ IO.readCreateProcessWithExitCode cp ""
+
 -- | Execute a process, returning '()'.
 exec_
   :: (MonadTest m, MonadIO m, HasCallStack)
@@ -194,34 +205,42 @@ exec_
   -> m ()
 exec_ execConfig bin arguments = void $ exec execConfig bin arguments
 
--- | Execute a process
+-- | Execute a process, returning the stdout. Fail if the call returns
+-- with a non-zero exit code. For a version that doesn't fail upon receiving
+-- a non-zero exit code, see 'execAny'.
 exec
   :: (MonadTest m, MonadIO m, HasCallStack)
   => ExecConfig
   -> String
   -> [String]
   -> m String
 exec execConfig bin arguments = GHC.withFrozenCallStack $ do
-  let cp = (IO.proc bin arguments)
-        { IO.env = getLast $ execConfigEnv execConfig
-        , IO.cwd = getLast $ execConfigCwd execConfig
-        }
-  H.annotate . ("Command: " <>) $ bin <> " " <> L.unwords arguments
-  (exitResult, stdout, stderr) <- H.evalIO $ IO.readCreateProcessWithExitCode cp ""
+  (exitResult, stdout, stderr) <- execAny execConfig bin arguments
   case exitResult of
     IO.ExitFailure exitCode -> H.failMessage GHC.callStack . L.unlines $
-      [ "Process exited with non-zero exit-code"
+      [ "Process exited with non-zero exit-code: " ++ show @Int exitCode
       , "━━━━ command ━━━━"
       , bin <> " " <> L.unwords (fmap argQuote arguments)
-      , "━━━━ stdout ━━━━"
-      , stdout
-      , "━━━━ stderr ━━━━"
-      , stderr
-      , "━━━━ exit code ━━━━"
-      , show @Int exitCode
       ]
+      ++ if L.null stdout then [] else ["━━━━ stdout ━━━━" , stdout]
+      ++ if L.null stderr then [] else ["━━━━ stderr ━━━━" , stderr]
     IO.ExitSuccess -> return stdout
 
+-- | Execute a process, returning the error code, the stdout, and the stderr.
+execAny
+  :: (MonadTest m, MonadIO m, HasCallStack)
+  => ExecConfig
+  -> String
+  -> [String]
+  -> m (ExitCode, String, String)
+execAny execConfig bin arguments = GHC.withFrozenCallStack $ do
+  let cp = (IO.proc bin arguments)
+        { IO.env = getLast $ execConfigEnv execConfig
+        , IO.cwd = getLast $ execConfigCwd execConfig
+        }
+  H.annotate . ("Command: " <>) $ bin <> " " <> L.unwords arguments
+  H.evalIO $ IO.readCreateProcessWithExitCode cp ""
+
 -- | Wait for process to exit.
 waitForProcess
   :: (MonadTest m, MonadIO m, HasCallStack)