Decode as UTF-8 in ExitCodeException's Show instance

Partial fix for #86. This isn't perfect (for retrocomputing you may want
another character encoding) but improves the behavior in many
circumstances.

Author: 9999years

package.yaml

@@ -21,6 +21,7 @@ dependencies:
 - stm
 - transformers
 - unliftio-core
+- text
 
 library:
   source-dirs: src

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)
@@ -616,17 +620,20 @@ data ExitCodeException = ExitCodeException
 instance Exception ExitCodeException
 instance Show ExitCodeException where
     show ece =
-        let stdout = L8.unpack $ eceStdout ece
-            stderr = L8.unpack $ eceStderr ece
-            stdout' = if L.null (eceStdout ece)
+        let decode = TL.toStrict . TLE.decodeUtf8With lenientDecode
+
+            stdout = decode $ eceStdout ece
+            stderr = decode $ eceStderr ece
+
+            stdout' = if T.null stdout
                          then []
                          else [ "\n\nStandard output:\n"
-                              , stdout
+                              , T.unpack stdout
                               ]
-            stderr' = if L.null (eceStderr ece)
+            stderr' = if T.null stderr
                          then []
                          else [ "\nStandard error:\n"
-                              , stderr
+                              , T.unpack stderr
                               ]
         in concat $
             [ "Received "

test/System/Process/TypedSpec.hs

@@ -15,6 +15,7 @@ import qualified Data.ByteString.Lazy as L
 import Data.String (IsString(..))
 import Data.Monoid ((<>))
 import qualified Data.ByteString.Base64 as B64
+import GHC.IsList (IsList(fromList))
 
 #if !MIN_VERSION_base(4, 8, 0)
 import Control.Applicative ((*>))
@@ -341,3 +342,106 @@ spec = do
                     ++ "puppy\n"
                     ++ "Standard error:\n"
                     ++ "doggy"
+
+        it "decodes UTF-8" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , eceStdout = fromList [0x61, 0xc2, 0xa9, 0xe2, 0x82, 0xac, 0xf0, 0x9f, 0x92, 0xa9, 0x0a]
+                      , eceStderr = fromList [0x61, 0xc2, 0xa9, 0xe2, 0x82, 0xac, 0xf0, 0x9f, 0x92, 0xa9, 0x0a]
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "a©€💩\n"
+                ++ "\n"
+                ++ "Standard error:\n"
+                ++ "a©€💩\n"
+
+        it "decodes UTF-8 leniently (overlong)" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , -- Overlong sequence, U+20AC € encoded as 4 bytes.
+                        -- We get four U+FFFD � replacement characters out, one
+                        -- for each byte in the sequence.
+                        eceStdout = fromList [ 0xf0, 0x82, 0x82, 0xac, 0x0a ]
+                      , eceStderr = L.empty
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "����\n"
+
+        it "decodes UTF-8 leniently (lone surrogate)" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , -- Half of a surrogate pair, invalid in UTF-8. (U+D800)
+                        eceStdout = fromList [ 0xed, 0xa0, 0x80, 0x0a]
+                      , eceStderr = L.empty
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "���\n"
+
+        it "decodes UTF-8 leniently (unexpected continuation)" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , -- An unexpected continuation byte.
+                        eceStdout = fromList [ 0xa0, 0x80, 0x0a]
+                      , eceStderr = L.empty
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "��\n"
+
+        it "decodes UTF-8 leniently (missing continuation)" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , -- Missing a continuation byte.
+                        eceStdout = fromList [ 0xf0, 0x9f, 0x90, 0x0a]
+                      , eceStderr = L.empty
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "���\n"
+
+        it "decodes UTF-8 leniently (invalid byte)" $ do
+            let exitCodeException =
+                  ExitCodeException
+                      { eceExitCode = ExitFailure 1
+                      , eceProcessConfig = proc "puppy" []
+                      , -- Invalid bytes (no defined meaning in UTF-8).
+                        eceStdout = fromList [ 0xc0, 0x0a, 0xc1, 0x0a, 0xf5, 0x0a, 0xff, 0x0a]
+                      , eceStderr = L.empty
+                      }
+            show exitCodeException `shouldBe`
+                "Received ExitFailure 1 when running\n"
+                ++ "Raw command: puppy\n"
+                ++ "\n"
+                ++ "Standard output:\n"
+                ++ "�\n"
+                ++ "�\n"
+                ++ "�\n"
+                ++ "�\n"