Skip to content

Commit 9e70f3a

Browse files
9999years9999years
committed
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.
1 parent d5e9fb3 commit 9e70f3a

File tree

2 files changed

+192
-34
lines changed

2 files changed

+192
-34
lines changed

‎src/System/Process/Typed/Internal.hs

Lines changed: 51 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,10 @@ import qualified Control.Exception as E
1717
import Control.Exception hiding (bracket, finally, handle)
1818
import Control.Monad (void)
1919
import qualified System.Process as P
20+
import qualified Data.Text as T
21+
import Data.Text.Encoding.Error (lenientDecode)
22+
import qualified Data.Text.Lazy as TL (toStrict)
23+
import qualified Data.Text.Lazy.Encoding as TLE
2024
import Data.Typeable (Typeable)
2125
import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile)
2226
import Control.Concurrent.Async (async)
@@ -88,29 +92,38 @@ data ProcessConfig stdin stdout stderr = ProcessConfig
8892
#endif
8993
}
9094
instance Show (ProcessConfig stdin stdout stderr) where
91-
show pc = concat
92-
[ case pcCmdSpec pc of
93-
P.ShellCommand s -> "Shell command: " ++ s
94-
P.RawCommand x xs -> "Raw command: " ++ unwords (map escape (x:xs))
95-
, "\n"
96-
, case pcWorkingDir pc of
97-
Nothing -> ""
98-
Just wd -> concat
99-
[ "Run from: "
100-
, wd
101-
, "\n"
102-
]
103-
, case pcEnv pc of
104-
Nothing -> ""
105-
Just e -> unlines
106-
$ "Modified environment:"
107-
: map (\(k, v) -> concat [k, "=", v]) e
108-
]
95+
show pc = concat $
96+
command
97+
++ workingDir
98+
++ env
10999
where
110100
escape x
111101
| any (`elem` " \\\"'") x = show x
112102
| x == "" = "\"\""
113103
| otherwise = x
104+
105+
command =
106+
case pcCmdSpec pc of
107+
P.ShellCommand s -> ["Shell command: ", s]
108+
P.RawCommand program args ->
109+
["Raw command:"]
110+
++ do arg <- program:args
111+
[" ", escape arg]
112+
113+
workingDir =
114+
case pcWorkingDir pc of
115+
Nothing -> []
116+
Just wd -> ["\nRun from: ", wd]
117+
118+
env =
119+
case pcEnv pc of
120+
Nothing -> []
121+
Just [] -> []
122+
Just env' ->
123+
["\nEnvironment:"]
124+
++ do (key, value) <- env'
125+
["\n", key, "=", value]
126+
114127
instance (stdin ~ (), stdout ~ (), stderr ~ ())
115128
=> IsString (ProcessConfig stdin stdout stderr) where
116129
fromString s
@@ -607,20 +620,26 @@ data ExitCodeException = ExitCodeException
607620
deriving Typeable
608621
instance Exception ExitCodeException
609622
instance Show ExitCodeException where
610-
show ece = concat
611-
[ "Received "
612-
, show (eceExitCode ece)
613-
, " when running\n"
614-
-- Too much output for an exception if we show the modified
615-
-- environment, so hide it
616-
, show (eceProcessConfig ece) { pcEnv = Nothing }
617-
, if L.null (eceStdout ece)
618-
then ""
619-
else "Standard output:\n\n" ++ L8.unpack (eceStdout ece)
620-
, if L.null (eceStderr ece)
621-
then ""
622-
else "Standard error:\n\n" ++ L8.unpack (eceStderr ece)
623-
]
623+
show ece =
624+
let decodeStrip = T.unpack . T.strip . TL.toStrict . TLE.decodeUtf8With lenientDecode
625+
stdout = decodeStrip $ eceStdout ece
626+
stderr = decodeStrip $ eceStderr ece
627+
stdout' = if null stdout
628+
then []
629+
else ["\n\nStandard output:\n", stdout]
630+
stderr' = if null stderr
631+
then []
632+
else ["\n\nStandard error:\n", stderr]
633+
in concat $
634+
[ "Received "
635+
, show (eceExitCode ece)
636+
, " when running\n"
637+
-- Too much output for an exception if we show the modified
638+
-- environment, so hide it.
639+
, show (eceProcessConfig ece) { pcEnv = Nothing }
640+
]
641+
++ stdout'
642+
++ stderr'
624643

625644
-- | Wrapper for when an exception is thrown when reading from a child
626645
-- process, used by 'byteStringOutput'.

‎test/System/Process/TypedSpec.hs

Lines changed: 141 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import System.Exit
1212
import System.IO.Temp
1313
import qualified Data.ByteString as S
1414
import qualified Data.ByteString.Lazy as L
15-
import Data.String (IsString)
15+
import Data.String (IsString(..))
1616
import Data.Monoid ((<>))
1717
import qualified Data.ByteString.Base64 as B64
1818

@@ -168,5 +168,144 @@ spec = do
168168
L.take (L.length expected) lbs1 `shouldBe` expected
169169

170170
it "empty param are showed" $
171-
let expected = "Raw command: podman exec --detach-keys \"\" ctx bash\n"
171+
let expected = "Raw command: podman exec --detach-keys \"\" ctx bash"
172172
in show (proc "podman" ["exec", "--detach-keys", "", "ctx", "bash"]) `shouldBe` expected
173+
174+
describe "ProcessConfig" $ do
175+
it "Show shell-escapes arguments" $ do
176+
let processConfig = proc "echo" ["a", "", "\"b\"", "'c'", "\\d"]
177+
-- I promise this escaping behavior is correct; paste it into GHCi
178+
-- `putStrLn` and then paste it into `sh` to verify.
179+
show processConfig `shouldBe`
180+
"Raw command: echo a \"\" \"\\\"b\\\"\" \"'c'\" \"\\\\d\""
181+
182+
it "Show displays working directory" $ do
183+
let processConfig = setWorkingDir "puppy/doggy" $ proc "true" []
184+
show processConfig `shouldBe`
185+
"Raw command: true\n"
186+
++ "Run from: puppy/doggy"
187+
188+
it "Show displays environment (1 variable)" $ do
189+
let processConfig = setEnv [("PUPPY", "DOGGY")] $ proc "true" []
190+
show processConfig `shouldBe`
191+
"Raw command: true\n"
192+
++ "Environment:\n"
193+
++ "PUPPY=DOGGY"
194+
195+
it "Show displays environment (multiple variables)" $ do
196+
let processConfig =
197+
setEnv [ ("PUPPY", "DOGGY")
198+
, ("SOUND", "AWOO")
199+
, ("HOWLING", "RIGHT_NOW")
200+
]
201+
$ proc "true" []
202+
show processConfig `shouldBe`
203+
"Raw command: true\n"
204+
++ "Environment:\n"
205+
++ "PUPPY=DOGGY\n"
206+
++ "SOUND=AWOO\n"
207+
++ "HOWLING=RIGHT_NOW"
208+
209+
it "Show displays working directory and environment" $ do
210+
let processConfig =
211+
setEnv [ ("PUPPY", "DOGGY")
212+
, ("SOUND", "AWOO")
213+
]
214+
$ setWorkingDir "puppy/doggy"
215+
$ proc "true" []
216+
show processConfig `shouldBe`
217+
"Raw command: true\n"
218+
++ "Run from: puppy/doggy\n"
219+
++ "Environment:\n"
220+
++ "PUPPY=DOGGY\n"
221+
++ "SOUND=AWOO"
222+
223+
224+
describe "ExitCodeException" $ do
225+
it "Show" $ do
226+
let exitCodeException =
227+
ExitCodeException
228+
{ eceExitCode = ExitFailure 1
229+
, eceProcessConfig = proc "cp" ["a", "b"]
230+
, eceStdout = fromString "Copied OK\n"
231+
, eceStderr = fromString "Uh oh!\n"
232+
}
233+
show exitCodeException `shouldBe`
234+
"Received ExitFailure 1 when running\n"
235+
++ "Raw command: cp a b\n"
236+
++ "\n"
237+
++ "Standard output:\n"
238+
++ "Copied OK\n"
239+
++ "\n"
240+
++ "Standard error:\n"
241+
++ "Uh oh!"
242+
243+
it "Show only stdout" $ do
244+
let exitCodeException =
245+
ExitCodeException
246+
{ eceExitCode = ExitFailure 1
247+
, eceProcessConfig = proc "show-puppy" []
248+
, eceStdout = fromString "No puppies found???\n"
249+
, eceStderr = fromString ""
250+
}
251+
show exitCodeException `shouldBe`
252+
"Received ExitFailure 1 when running\n"
253+
++ "Raw command: show-puppy\n"
254+
++ "\n"
255+
++ "Standard output:\n"
256+
++ "No puppies found???"
257+
258+
it "Show only stderr" $ do
259+
let exitCodeException =
260+
ExitCodeException
261+
{ eceExitCode = ExitFailure 1
262+
, eceProcessConfig = proc "show-puppy" []
263+
, eceStdout = fromString ""
264+
, eceStderr = fromString "No puppies found???\n"
265+
}
266+
show exitCodeException `shouldBe`
267+
"Received ExitFailure 1 when running\n"
268+
++ "Raw command: show-puppy\n"
269+
++ "\n"
270+
++ "Standard error:\n"
271+
++ "No puppies found???"
272+
273+
it "Show trims stdout/stderr" $ do
274+
-- This keeps the `Show` output looking nice regardless of how many
275+
-- newlines (if any) the command outputs.
276+
--
277+
-- This also makes sure that the `Show` output doesn't end with a
278+
-- spurious trailing newline, making it easier to compose `Show`
279+
-- instances together.
280+
let exitCodeException =
281+
ExitCodeException
282+
{ eceExitCode = ExitFailure 1
283+
, eceProcessConfig = proc "detect-doggies" []
284+
, eceStdout = fromString "\n\npuppy\n\n \n"
285+
, eceStderr = fromString "\t \ndoggy\n \t\n"
286+
}
287+
show exitCodeException `shouldBe`
288+
"Received ExitFailure 1 when running\n"
289+
++ "Raw command: detect-doggies\n"
290+
++ "\n"
291+
++ "Standard output:\n"
292+
++ "puppy\n"
293+
++ "\n"
294+
++ "Standard error:\n"
295+
++ "doggy"
296+
297+
it "Show displays correctly with no newlines in stdout" $ do
298+
-- Sometimes, commands don't output _any_ newlines!
299+
let exitCodeException =
300+
ExitCodeException
301+
{ eceExitCode = ExitFailure 1
302+
, eceProcessConfig = proc "detect-doggies" []
303+
, eceStdout = fromString "puppy"
304+
, eceStderr = fromString ""
305+
}
306+
show exitCodeException `shouldBe`
307+
"Received ExitFailure 1 when running\n"
308+
++ "Raw command: detect-doggies\n"
309+
++ "\n"
310+
++ "Standard output:\n"
311+
++ "puppy"

0 commit comments

Comments
 (0)