Improve ExitCodeException Show instance

Before, the arrangement of newlines in the `ExitCodeException` `Show`
instance grouped stdout closer to the stderr header than the stdout
header:

    ghci> readProcess_ $ proc "sh" ["-c", "echo this is stdout; echo this is stderr >&2; false"]
    *** Exception: Received ExitFailure 1 when running
    Raw command: sh -c "echo this is stdout; echo this is stderr >&2; false"
    Standard output:

    this is stdout
    Standard error:

    this is stderr

If there was no trailing newline for the stdout, the output would be
formatted with no newline between the end of the stdout and the start of
the stderr header:

    ghci> readProcess_ $ proc "sh" ["-c", "nix path-info --json nixpkgs#agda && false"]
    *** Exception: Received ExitFailure 1 when running
    Raw command: sh -c "nix path-info --json nixpkgs#agda && false"
    Standard output:

    [{"path":"/nix/store/sj2z0h5ywlflqv50dfphwia6p0ij0mlj-agdaWithPackages-2.6.4.3","valid":false}]Standard error:

    these 5 paths will be fetched (18.30 MiB download, 133.19 MiB unpacked):
      /nix/store/5q0kb0nqnqcfs7a0ncsjq4fdppwirpxa-Agda-2.6.4.3-bin
      /nix/store/xmximjjnkn0hm4gw7akc9f20ydz6msmk-Agda-2.6.4.3-data
      /nix/store/sj2z0h5ywlflqv50dfphwia6p0ij0mlj-agdaWithPackages-2.6.4.3
      /nix/store/b49sa2q0yb3fd14ppzh6j6rm8vvgr9n6-ghc-9.6.6-with-packages
      /nix/store/vharimf7f2glj4fyhiglzws0qyv4xrry-libraries

Now, the output is grouped more consistently and displays nicely
regardless of trailing or leading newlines in the output:

    ghci> readProcess_ $ proc "sh" ["-c", "echo this is stdout; echo this is stderr >&2; false"]
    *** Exception: Received ExitFailure 1 when running
    Raw command: sh -c "echo this is stdout; echo this is stderr >&2; false"

    Standard output:
    this is stdout

    Standard error:
    this is stderr

    ghci> readProcess_ $ proc "sh" ["-c", "nix path-info --json nixpkgs#agda && false"]
    *** Exception: Received ExitFailure 1 when running
    Raw command: sh -c "nix path-info --json nixpkgs#agda && false"

    Standard output:
    [{"path":"/nix/store/sj2z0h5ywlflqv50dfphwia6p0ij0mlj-agdaWithPackages-2.6.4.3","valid":false}]

    Standard error:
    these 5 paths will be fetched (18.30 MiB download, 133.19 MiB unpacked):
      /nix/store/5q0kb0nqnqcfs7a0ncsjq4fdppwirpxa-Agda-2.6.4.3-bin
      /nix/store/xmximjjnkn0hm4gw7akc9f20ydz6msmk-Agda-2.6.4.3-data
      /nix/store/sj2z0h5ywlflqv50dfphwia6p0ij0mlj-agdaWithPackages-2.6.4.3
      /nix/store/b49sa2q0yb3fd14ppzh6j6rm8vvgr9n6-ghc-9.6.6-with-packages
      /nix/store/vharimf7f2glj4fyhiglzws0qyv4xrry-libraries

The `Show` instance for `ProcessConfig` has also been touched up,
removing edge cases like an empty "Modified environment" header:

    ghci> putStrLn $ show $ setEnv [] $ proc "sh" []
    Raw command: sh
    Modified environment:

Extraneous trailing newlines in `Show` instances have also been
removed.

src/System/Process/Typed/Internal.hs

@@ -17,6 +17,10 @@ import qualified Control.Exception as E
 import Control.Exception hiding (bracket, finally, handle)
 import Control.Monad (void)
 import qualified System.Process as P
+import qualified Data.Text as T
+import Data.Text.Encoding.Error (lenientDecode)
+import qualified Data.Text.Lazy as TL (toStrict)
+import qualified Data.Text.Lazy.Encoding as TLE
 import Data.Typeable (Typeable)
 import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile)
 import Control.Concurrent.Async (async)
@@ -88,29 +92,38 @@ data ProcessConfig stdin stdout stderr = ProcessConfig
 #endif
     }
 instance Show (ProcessConfig stdin stdout stderr) where
-    show pc = concat
-        [ case pcCmdSpec pc of
-            P.ShellCommand s -> "Shell command: " ++ s
-            P.RawCommand x xs -> "Raw command: " ++ unwords (map escape (x:xs))
-        , "\n"
-        , case pcWorkingDir pc of
-            Nothing -> ""
-            Just wd -> concat
-                [ "Run from: "
-                , wd
-                , "\n"
-                ]
-        , case pcEnv pc of
-            Nothing -> ""
-            Just e -> unlines
-                $ "Modified environment:"
-                : map (\(k, v) -> concat [k, "=", v]) e
-        ]
+    show pc = concat $
+        command
+        ++ workingDir
+        ++ env
       where
         escape x
             | any (`elem` " \\\"'") x = show x
             | x == "" = "\"\""
             | otherwise = x
+
+        command =
+            case pcCmdSpec pc of
+                P.ShellCommand s -> ["Shell command: ", s]
+                P.RawCommand program args ->
+                    ["Raw command:"]
+                    ++ do arg <- program:args
+                          [" ", escape arg]
+
+        workingDir =
+            case pcWorkingDir pc of
+              Nothing -> []
+              Just wd -> ["\nRun from: ", wd]
+
+        env =
+            case pcEnv pc of
+              Nothing -> []
+              Just [] -> []
+              Just env' ->
+                  ["\nEnvironment:"]
+                  ++ do (key, value) <- env'
+                        ["\n", key, "=", value]
+
 instance (stdin ~ (), stdout ~ (), stderr ~ ())
   => IsString (ProcessConfig stdin stdout stderr) where
     fromString s
@@ -607,20 +620,26 @@ data ExitCodeException = ExitCodeException
     deriving Typeable
 instance Exception ExitCodeException
 instance Show ExitCodeException where
-    show ece = concat
-        [ "Received "
-        , show (eceExitCode ece)
-        , " when running\n"
-        -- Too much output for an exception if we show the modified
-        -- environment, so hide it
-        , show (eceProcessConfig ece) { pcEnv = Nothing }
-        , if L.null (eceStdout ece)
-            then ""
-            else "Standard output:\n\n" ++ L8.unpack (eceStdout ece)
-        , if L.null (eceStderr ece)
-            then ""
-            else "Standard error:\n\n" ++ L8.unpack (eceStderr ece)
-        ]
+    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
+                         then []
+                         else ["\n\nStandard output:\n", stdout]
+            stderr' = if null stderr
+                         then []
+                         else ["\n\nStandard error:\n", stderr]
+        in concat $
+            [ "Received "
+            , show (eceExitCode ece)
+            , " when running\n"
+            -- Too much output for an exception if we show the modified
+            -- environment, so hide it.
+            , show (eceProcessConfig ece) { pcEnv = Nothing }
+            ]
+            ++ stdout'
+            ++ stderr'
 
 -- | Wrapper for when an exception is thrown when reading from a child
 -- process, used by 'byteStringOutput'.

test/System/Process/TypedSpec.hs

@@ -12,7 +12,7 @@ import System.Exit
 import System.IO.Temp
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
-import Data.String (IsString)
+import Data.String (IsString(..))
 import Data.Monoid ((<>))
 import qualified Data.ByteString.Base64 as B64
 
@@ -170,3 +170,142 @@ spec = do
     it "empty param are showed" $
       let expected = "Raw command: podman exec --detach-keys \"\" ctx bash\n"
        in show (proc "podman" ["exec", "--detach-keys", "", "ctx", "bash"]) `shouldBe` expected
+
+    describe "ProcessConfig" $ do
+        it "Show shell-escapes arguments" $ do
+            let processConfig = proc "echo" ["a", "", "\"b\"", "'c'", "\\d"]
+            -- I promise this escaping behavior is correct; paste it into GHCi
+            -- `putStrLn` and then paste it into `sh` to verify.
+            show processConfig `shouldBe`
+                "Raw command: echo a \"\" \"\\\"b\\\"\" \"'c'\" \"\\\\d\""
+
+        it "Show displays working directory" $ do
+            let processConfig = setWorkingDir "puppy/doggy" $ proc "true" []
+            show processConfig `shouldBe`
+                "Raw command: true\n"
+                ++ "Run from: puppy/doggy"
+
+        it "Show displays environment (1 variable)" $ do
+            let processConfig = setEnv [("PUPPY", "DOGGY")] $ proc "true" []
+            show processConfig `shouldBe`
+                "Raw command: true\n"
+                ++ "Environment:\n"
+                ++ "PUPPY=DOGGY"
+
+        it "Show displays environment (multiple variables)" $ do
+            let processConfig =
+                    setEnv [ ("PUPPY", "DOGGY")
+                           , ("SOUND", "AWOO")
+                           , ("HOWLING", "RIGHT_NOW")
+                           ]
+                    $ proc "true" []
+            show processConfig `shouldBe`
+                "Raw command: true\n"
+                ++ "Environment:\n"
+                ++ "PUPPY=DOGGY\n"
+                ++ "SOUND=AWOO\n"
+                ++ "HOWLING=RIGHT_NOW"
+
+        it "Show displays working directory and environment" $ do
+            let processConfig =
+                    setEnv [ ("PUPPY", "DOGGY")
+                           , ("SOUND", "AWOO")
+                           ]
+                    $ setWorkingDir "puppy/doggy"
+                    $ proc "true" []
+            show processConfig `shouldBe`
+                "Raw command: true\n"
+                ++ "Run from: puppy/doggy\n"
+                ++ "Environment:\n"
+                ++ "PUPPY=DOGGY\n"
+                ++ "SOUND=AWOO"
+
+
+    describe "ExitCodeException" $ do
+        it "Show" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "cp" ["a", "b"]
+                      , eceStdout = fromString "Copied OK\n"
+                      , eceStderr = fromString "Uh oh!\n"
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: cp a b\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "Copied OK\n"
+                ++ "\n"
+                ++ "Standard error:\n"
+                ++ "Uh oh!"
+
+        it "Show only stdout" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "show-puppy" []
+                      , eceStdout = fromString "No puppies found???\n"
+                      , eceStderr = fromString ""
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: show-puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "No puppies found???"
+
+        it "Show only stderr" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "show-puppy" []
+                      , eceStdout = fromString ""
+                      , eceStderr = fromString "No puppies found???\n"
+                      }
+            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.
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "detect-doggies" []
+                      , eceStdout = fromString "\n\npuppy\n\n \n"
+                      , eceStderr = fromString "\t \ndoggy\n \t\n"
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: detect-doggies\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "puppy\n"
+                ++ "\n"
+                ++ "Standard error:\n"
+                ++ "doggy"
+
+        it "Show displays correctly with no newlines in stdout" $ do
+            -- Sometimes, commands don't output _any_ newlines!
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "detect-doggies" []
+                      , eceStdout = fromString "puppy"
+                      , eceStderr = fromString ""
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: detect-doggies\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "puppy"