From e841a7332edc37f09eab255a96fe81e578a36e84 Mon Sep 17 00:00:00 2001
From: Rebecca Turner <rbt@sent.as>
Date: Thu, 15 Aug 2024 10:59:48 -0700
Subject: [PATCH 1/2] 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, 52 insertions(+), 9 deletions(-)

diff --git a/src/System/Process/Typed.hs b/src/System/Process/Typed.hs
index 42bd787..abb0303 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 = 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 = 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..18942e1 100644
--- a/src/System/Process/Typed/Internal.hs
+++ b/src/System/Process/Typed/Internal.hs
@@ -590,13 +590,17 @@ 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'.
 -- This prevents unbounded memory usage for large stdout and stderrs.
 --
+-- Functions which do include 'eceStdout' or 'eceStderr' (like
+-- 'System.Process.Typed.readProcess_') state so in their documentation.
+--
 -- @since 0.1.0.0
 data ExitCodeException = ExitCodeException
     { eceExitCode :: ExitCode

From c4505b1bf2fe8e3d9a55b266e19137d467dd5f61 Mon Sep 17 00:00:00 2001
From: Rebecca Turner <rbt@sent.as>
Date: Thu, 15 Aug 2024 11:05:04 -0700
Subject: [PATCH 2/2] Add `getProcessConfig`

This enables third-parties to construct their own `ExitCodeException`s
from `Process` values.
---
 src/System/Process/Typed.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/src/System/Process/Typed.hs b/src/System/Process/Typed.hs
index abb0303..5978d35 100644
--- a/src/System/Process/Typed.hs
+++ b/src/System/Process/Typed.hs
@@ -664,6 +664,18 @@ getStdout = pStdout
 getStderr :: Process stdin stdout stderr -> stderr
 getStderr = pStderr
 
+-- | Get a process's configuration.
+--
+-- This is useful for constructing 'ExitCodeException's.
+--
+-- Note that the stdin, stdout, and stderr streams are stored in the 'Process',
+-- not the 'ProcessConfig', so the returned 'ProcessConfig' will always have
+-- empty stdin, stdout, and stderr values.
+--
+-- @since 0.2.12.0
+getProcessConfig :: Process stdin stdout stderr -> ProcessConfig () () ()
+getProcessConfig = pConfig
+
 -- | Take 'System.Process.ProcessHandle' out of the 'Process'.
 -- This method is needed in cases one need to use low level functions
 -- from the @process@ package. Use cases for this method are: