From 189aa42ca01a83ce3392736db6f83c05c63cff39 Mon Sep 17 00:00:00 2001
From: Tom Ellis <tom-git@jaguarpaw.co.uk>
Date: Sat, 17 Aug 2024 09:38:54 +0100
Subject: [PATCH] Don't strip whitespace from stdout/stderr

---
 package.yaml                         |  1 +
 src/System/Process/Typed/Internal.hs | 27 +++++++++++-----
 test/System/Process/TypedSpec.hs     | 47 +++++++++++++++++++---------
 3 files changed, 53 insertions(+), 22 deletions(-)

diff --git a/package.yaml b/package.yaml
index 76bdc96..c0de369 100644
--- a/package.yaml
+++ b/package.yaml
@@ -21,6 +21,7 @@ dependencies:
 - stm
 - transformers
 - unliftio-core
+- text
 
 library:
   source-dirs: src
diff --git a/src/System/Process/Typed/Internal.hs b/src/System/Process/Typed/Internal.hs
index 4ba505c..fe662c7 100644
--- a/src/System/Process/Typed/Internal.hs
+++ b/src/System/Process/Typed/Internal.hs
@@ -621,15 +621,28 @@ data ExitCodeException = ExitCodeException
 instance Exception ExitCodeException
 instance Show ExitCodeException where
     show ece =
-        let decodeStrip = T.unpack . T.strip . TL.toStrict . TLE.decodeUtf8With lenientDecode
-            stdout = decodeStrip $ eceStdout ece
-            stderr = decodeStrip $ eceStderr ece
-            stdout' = if null stdout
+        let decode = TL.toStrict . TLE.decodeUtf8With lenientDecode
+
+            isAsciiSpace char = case char of
+                                  ' ' -> True
+                                  '\t' -> True
+                                  '\n' -> True
+                                  '\r' -> True
+                                  _ -> False
+            isOnlyAsciiWhitespace = T.null . T.dropAround isAsciiSpace
+
+            stdout = decode $ eceStdout ece
+            stderr = decode $ eceStderr ece
+            stdout' = if isOnlyAsciiWhitespace stdout
                          then []
-                         else ["\n\nStandard output:\n", stdout]
-            stderr' = if null stderr
+                         else [ "\n\nStandard output:\n"
+                              , T.unpack stdout
+                              ]
+            stderr' = if isOnlyAsciiWhitespace stderr
                          then []
-                         else ["\n\nStandard error:\n", stderr]
+                         else [ "\nStandard error:\n"
+                              , T.unpack stderr
+                              ]
         in concat $
             [ "Received "
             , show (eceExitCode ece)
diff --git a/test/System/Process/TypedSpec.hs b/test/System/Process/TypedSpec.hs
index 5626fb7..2a80505 100644
--- a/test/System/Process/TypedSpec.hs
+++ b/test/System/Process/TypedSpec.hs
@@ -223,6 +223,9 @@ spec = do
 
     describe "ExitCodeException" $ do
         it "Show" $ do
+            -- Note that the `show` output ends with a newline, so functions
+            -- like `print` will output an extra blank line at the end of the
+            -- output.
             let exitCodeException =
                   ExitCodeException
                       { eceExitCode = ExitFailure 1
@@ -238,7 +241,7 @@ spec = do
                 ++ "Copied OK\n"
                 ++ "\n"
                 ++ "Standard error:\n"
-                ++ "Uh oh!"
+                ++ "Uh oh!\n"
 
         it "Show only stdout" $ do
             let exitCodeException =
@@ -253,7 +256,7 @@ spec = do
                 ++ "Raw command: show-puppy\n"
                 ++ "\n"
                 ++ "Standard output:\n"
-                ++ "No puppies found???"
+                ++ "No puppies found???\n"
 
         it "Show only stderr" $ do
             let exitCodeException =
@@ -266,17 +269,12 @@ spec = do
             show exitCodeException `shouldBe`
                 "Received ExitFailure 1 when running\n"
                 ++ "Raw command: show-puppy\n"
-                ++ "\n"
                 ++ "Standard error:\n"
-                ++ "No puppies found???"
-
-        it "Show trims stdout/stderr" $ do
-            -- This keeps the `Show` output looking nice regardless of how many
-            -- newlines (if any) the command outputs.
-            --
-            -- This also makes sure that the `Show` output doesn't end with a
-            -- spurious trailing newline, making it easier to compose `Show`
-            -- instances together.
+                ++ "No puppies found???\n"
+
+        it "Show does not trim stdout/stderr" $ do
+            -- This looks weird, and I think it would be better to strip the
+            -- whitespace from the output.
             let exitCodeException =
                   ExitCodeException
                       { eceExitCode = ExitFailure 1
@@ -289,12 +287,12 @@ spec = do
                 ++ "Raw command: detect-doggies\n"
                 ++ "\n"
                 ++ "Standard output:\n"
-                ++ "puppy\n"
+                ++ "\n\npuppy\n\n \n"
                 ++ "\n"
                 ++ "Standard error:\n"
-                ++ "doggy"
+                ++ "\t \ndoggy\n \t\n"
 
-        it "Show displays correctly with no newlines in stdout" $ do
+        it "Show displays weirdly with no newlines in stdout" $ do
             -- Sometimes, commands don't output _any_ newlines!
             let exitCodeException =
                   ExitCodeException
@@ -309,3 +307,22 @@ spec = do
                 ++ "\n"
                 ++ "Standard output:\n"
                 ++ "puppy"
+
+        it "Show displays weirdly with no newlines in stdout or stderr" $ do
+            -- If the stderr isn't empty and stdout doesn't end with a newline,
+            -- the blank line between the two sections disappears.
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "detect-doggies" []
+                      , eceStdout = fromString "puppy"
+                      , eceStderr = fromString "doggy"
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: detect-doggies\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "puppy\n"
+                ++ "Standard error:\n"
+                ++ "doggy"