Skip to content

Decode as UTF-8 in ExitCodeException's Show instance #89

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ dependencies:
- stm
- transformers
- unliftio-core
- text

library:
source-dirs: src
Expand Down
88 changes: 56 additions & 32 deletions src/System/Process/Typed/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -88,29 +92,37 @@ 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 env' ->
["\nModified environment:"]
++ do (key, value) <- env'
["\n", key, "=", value]

instance (stdin ~ (), stdout ~ (), stderr ~ ())
=> IsString (ProcessConfig stdin stdout stderr) where
fromString s
Expand Down Expand Up @@ -607,20 +619,32 @@ 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 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"
, T.unpack stdout
]
stderr' = if T.null stderr
then []
else [ "\nStandard error:\n"
, T.unpack 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'.
Expand Down
Loading