From b1f0ff35a9860242e069e454f3c0ab25a0da18a1 Mon Sep 17 00:00:00 2001
From: Rebecca Turner <rbt@sent.as>
Date: Thu, 15 Aug 2024 10:59:48 -0700
Subject: [PATCH] Add `ExitCodeException` smart constructors

`ExitCodeException`s thrown by `typed-process` never populate the
`eceStdout` or `eceStderr` fields, and it's impossible to construct an
`ExitCodeException` manually because the `pConfig` field accessor is not
public. This patch adds two smart constructors,
`exitCodeExceptionWithOutput` and `exitCodeExceptionNoOutput`, to fill
these use cases.
---
 src/System/Process/Typed.hs          | 51 ++++++++++++++++++++++++----
 src/System/Process/Typed/Internal.hs | 10 +++---
 2 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/src/System/Process/Typed.hs b/src/System/Process/Typed.hs
index 42bd787..cf751e1 100644
--- a/src/System/Process/Typed.hs
+++ b/src/System/Process/Typed.hs
@@ -116,6 +116,8 @@ module System.Process.Typed
 
       -- * Exceptions
     , ExitCodeException (..)
+    , exitCodeExceptionWithOutput
+    , exitCodeExceptionNoOutput
     , ByteStringOutputException (..)
 
       -- * Re-exports
@@ -634,12 +636,7 @@ checkExitCodeSTM p = do
     ec <- readTMVar (pExitCode p)
     case ec of
         ExitSuccess -> return ()
-        _ -> throwSTM ExitCodeException
-            { eceExitCode = ec
-            , eceProcessConfig = clearStreams (pConfig p)
-            , eceStdout = L.empty
-            , eceStderr = L.empty
-            }
+        _ -> throwSTM $ exitCodeExceptionNoOutput p ec
 
 -- | Internal
 clearStreams :: ProcessConfig stdin stdout stderr -> ProcessConfig () () ()
@@ -688,3 +685,45 @@ getStderr = pStderr
 -- @since 0.1.1
 unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle
 unsafeProcessHandle = pHandle
+
+-- | Get an 'ExitCodeException' containing the process's stdout and stderr data.
+--
+-- Note that this will call 'waitExitCode' to block until the process exits, if
+-- it has not exited already.
+--
+-- Unlike 'checkExitCode' and similar, this will return an 'ExitCodeException'
+-- even if the process exits with 'ExitSuccess'.
+--
+-- @since 0.2.12.0
+exitCodeExceptionWithOutput :: MonadIO m
+                            => Process stdin (STM L.ByteString) (STM L.ByteString)
+                            -> m ExitCodeException
+exitCodeExceptionWithOutput process = liftIO $ atomically $ do
+    exitCode <- waitExitCodeSTM process
+    stdout <- getStdout process
+    stderr <- getStderr process
+    pure ExitCodeException
+        { eceExitCode = exitCode
+        , eceProcessConfig = clearStreams (pConfig process)
+        , eceStdout = stdout
+        , eceStderr = stderr
+        }
+
+-- | Get an 'ExitCodeException' containing no data other than the exit code and
+-- process config.
+--
+-- Unlike 'checkExitCode' and similar, this will return an 'ExitCodeException'
+-- even if the process exits with 'ExitSuccess'.
+--
+-- @since 0.2.12.0
+exitCodeExceptionNoOutput :: Process stdin stdout stderr
+                          -> ExitCode
+                          -> ExitCodeException
+exitCodeExceptionNoOutput process exitCode =
+    ExitCodeException
+        { eceExitCode = exitCode
+        , eceProcessConfig = clearStreams (pConfig process)
+        , eceStdout = L.empty
+        , eceStderr = L.empty
+        }
+
diff --git a/src/System/Process/Typed/Internal.hs b/src/System/Process/Typed/Internal.hs
index 47ae083..cf4895c 100644
--- a/src/System/Process/Typed/Internal.hs
+++ b/src/System/Process/Typed/Internal.hs
@@ -590,11 +590,13 @@ useHandleOpen h = mkStreamSpec (P.UseHandle h) $ \_ _ -> return ((), return ())
 useHandleClose :: Handle -> StreamSpec anyStreamType ()
 useHandleClose h = mkStreamSpec (P.UseHandle h) $ \_ _ -> return ((), hClose h)
 
--- | Exception thrown by 'checkExitCode' in the event of a non-success
--- exit code. Note that 'checkExitCode' is called by other functions
--- as well, like 'runProcess_' or 'readProcess_'.
+-- | Exception thrown by 'System.Process.Typed.checkExitCode' in the event of a
+-- non-success exit code. Note that 'System.Process.Typed.checkExitCode' is
+-- called by other functions as well, like 'System.Process.Typed.runProcess_'
+-- or 'System.Process.Typed.readProcess_'.
 --
--- Note that several functions that throw an 'ExitCodeException' intentionally do not populate 'eceStdout' or 'eceStderr'.
+-- Note that 'ExitCodeException's thrown by this package intentionally do not
+-- populate 'eceStdout' or 'eceStderr'.
 -- This prevents unbounded memory usage for large stdout and stderrs.
 --
 -- @since 0.1.0.0