Skip to content

Commit 3ce8c32

Browse files
9999years9999years
committed
Improve whitespace in ExitCodeException Show instance
Split off of #83. Before, `ProcessConfig`'s `Show` output would include a trailing newline. This has been fixed, so that derived `Show` output does not include newlines in weird places. Before: ghci> data Foo = Foo { a :: Int, b :: ProcessConfig () () (), c :: String } deriving Show ghci> Foo 1 (proc "echo" ["puppy"]) "doggy" Foo {a = 1, b = Raw command: echo puppy , c = "doggy"} After ghci> Foo 1 (proc "echo" ["puppy"]) "doggy" Foo {a = 1, b = Raw command: echo puppy, c = "doggy"} Whitespace for the `ExitCodeException` `Show` instance has also been adjusted, to place the output closer to the relevant headers. Before: 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 After: *** 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 Note that because trailing whitespace is not accounted for, it is still possible to get unintuitive results depending on what exactly the subprocess prints: ghci> readProcess_ $ proc "sh" ["-c", "echo -n this is stdout; echo -n this is stderr >&2; false"] *** Exception: Received ExitFailure 1 when running Raw command: sh -c "echo -n this is stdout; echo -n this is stderr >&2; false" Standard output: this is stdout Standard error: this is stderr
1 parent d5e9fb3 commit 3ce8c32

File tree

3 files changed

+227
-34
lines changed

3 files changed

+227
-34
lines changed

‎package.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ dependencies:
2121
- stm
2222
- transformers
2323
- unliftio-core
24+
- text
2425

2526
library:
2627
source-dirs: src

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

Lines changed: 53 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,37 @@ 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 env' ->
122+
["\nModified environment:"]
123+
++ do (key, value) <- env'
124+
["\n", key, "=", value]
125+
114126
instance (stdin ~ (), stdout ~ (), stderr ~ ())
115127
=> IsString (ProcessConfig stdin stdout stderr) where
116128
fromString s
@@ -607,20 +619,29 @@ data ExitCodeException = ExitCodeException
607619
deriving Typeable
608620
instance Exception ExitCodeException
609621
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-
]
622+
show ece =
623+
let stdout = L8.unpack $ eceStdout ece
624+
stderr = L8.unpack $ eceStderr ece
625+
stdout' = if L.null (eceStdout ece)
626+
then []
627+
else [ "\n\nStandard output:\n"
628+
, stdout
629+
]
630+
stderr' = if L.null (eceStderr ece)
631+
then []
632+
else [ "\nStandard error:\n"
633+
, stderr
634+
]
635+
in concat $
636+
[ "Received "
637+
, show (eceExitCode ece)
638+
, " when running\n"
639+
-- Too much output for an exception if we show the modified
640+
-- environment, so hide it.
641+
, show (eceProcessConfig ece) { pcEnv = Nothing }
642+
]
643+
++ stdout'
644+
++ stderr'
624645

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

‎test/System/Process/TypedSpec.hs‎

Lines changed: 173 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,176 @@ 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 "Show ProcessConfig" $ do
175+
it "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 "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 "displays environment (inherited)" $ do
189+
let processConfig = setEnvInherit $ proc "true" []
190+
show processConfig `shouldBe`
191+
"Raw command: true"
192+
193+
it "displays environment (cleared)" $ do
194+
let processConfig = setEnv [] $ proc "true" []
195+
show processConfig `shouldBe`
196+
"Raw command: true\n"
197+
++ "Modified environment:" -- lol
198+
199+
it "displays environment (1 variable)" $ do
200+
let processConfig = setEnv [("PUPPY", "DOGGY")] $ proc "true" []
201+
show processConfig `shouldBe`
202+
"Raw command: true\n"
203+
++ "Modified environment:\n"
204+
++ "PUPPY=DOGGY"
205+
206+
it "displays environment (multiple variables)" $ do
207+
let processConfig =
208+
setEnv [ ("PUPPY", "DOGGY")
209+
, ("SOUND", "AWOO")
210+
, ("HOWLING", "RIGHT_NOW")
211+
]
212+
$ proc "true" []
213+
show processConfig `shouldBe`
214+
"Raw command: true\n"
215+
++ "Modified environment:\n"
216+
++ "PUPPY=DOGGY\n"
217+
++ "SOUND=AWOO\n"
218+
++ "HOWLING=RIGHT_NOW"
219+
220+
it "displays working directory and environment" $ do
221+
let processConfig =
222+
setEnv [ ("PUPPY", "DOGGY")
223+
, ("SOUND", "AWOO")
224+
]
225+
$ setWorkingDir "puppy/doggy"
226+
$ proc "true" []
227+
show processConfig `shouldBe`
228+
"Raw command: true\n"
229+
++ "Run from: puppy/doggy\n"
230+
++ "Modified environment:\n"
231+
++ "PUPPY=DOGGY\n"
232+
++ "SOUND=AWOO"
233+
234+
235+
describe "Show ExitCodeException" $ do
236+
it "shows ExitCodeException" $ do
237+
-- Note that the `show` output ends with a newline, so functions
238+
-- like `print` will output an extra blank line at the end of the
239+
-- output.
240+
let exitCodeException =
241+
ExitCodeException
242+
{ eceExitCode = ExitFailure 1
243+
, eceProcessConfig = proc "cp" ["a", "b"]
244+
, eceStdout = fromString "Copied OK\n"
245+
, eceStderr = fromString "Uh oh!\n"
246+
}
247+
show exitCodeException `shouldBe`
248+
"Received ExitFailure 1 when running\n"
249+
++ "Raw command: cp a b\n"
250+
++ "\n"
251+
++ "Standard output:\n"
252+
++ "Copied OK\n"
253+
++ "\n"
254+
++ "Standard error:\n"
255+
++ "Uh oh!\n"
256+
257+
context "without stderr" $ do
258+
it "shows ExitCodeException" $ do
259+
let exitCodeException =
260+
ExitCodeException
261+
{ eceExitCode = ExitFailure 1
262+
, eceProcessConfig = proc "show-puppy" []
263+
, eceStdout = fromString "No puppies found???\n"
264+
, eceStderr = fromString ""
265+
}
266+
show exitCodeException `shouldBe`
267+
"Received ExitFailure 1 when running\n"
268+
++ "Raw command: show-puppy\n"
269+
++ "\n"
270+
++ "Standard output:\n"
271+
++ "No puppies found???\n"
272+
273+
context "without stdout" $ do
274+
it "shows ExitCodeException" $ do
275+
let exitCodeException =
276+
ExitCodeException
277+
{ eceExitCode = ExitFailure 1
278+
, eceProcessConfig = proc "show-puppy" []
279+
, eceStdout = fromString ""
280+
, eceStderr = fromString "No puppies found???\n"
281+
}
282+
show exitCodeException `shouldBe`
283+
"Received ExitFailure 1 when running\n"
284+
++ "Raw command: show-puppy\n"
285+
++ "Standard error:\n"
286+
++ "No puppies found???\n"
287+
288+
it "does not trim stdout/stderr" $ do
289+
-- This looks weird, and I think it would be better to strip the
290+
-- whitespace from the output.
291+
let exitCodeException =
292+
ExitCodeException
293+
{ eceExitCode = ExitFailure 1
294+
, eceProcessConfig = proc "detect-doggies" []
295+
, eceStdout = fromString "\n\npuppy\n\n \n"
296+
, eceStderr = fromString "\t \ndoggy\n \t\n"
297+
}
298+
show exitCodeException `shouldBe`
299+
"Received ExitFailure 1 when running\n"
300+
++ "Raw command: detect-doggies\n"
301+
++ "\n"
302+
++ "Standard output:\n"
303+
++ "\n\npuppy\n\n \n"
304+
++ "\n"
305+
++ "Standard error:\n"
306+
++ "\t \ndoggy\n \t\n"
307+
308+
context "without newlines in stdout" $ do
309+
it "shows ExitCodeException" $ do
310+
-- Sometimes, commands don't output _any_ newlines!
311+
let exitCodeException =
312+
ExitCodeException
313+
{ eceExitCode = ExitFailure 1
314+
, eceProcessConfig = proc "detect-doggies" []
315+
, eceStdout = fromString "puppy"
316+
, eceStderr = fromString ""
317+
}
318+
show exitCodeException `shouldBe`
319+
"Received ExitFailure 1 when running\n"
320+
++ "Raw command: detect-doggies\n"
321+
++ "\n"
322+
++ "Standard output:\n"
323+
++ "puppy"
324+
325+
context "without newlines in stdout or stderr" $ do
326+
it "shows ExitCodeException" $ do
327+
-- If the stderr isn't empty and stdout doesn't end with a newline,
328+
-- the blank line between the two sections disappears.
329+
let exitCodeException =
330+
ExitCodeException
331+
{ eceExitCode = ExitFailure 1
332+
, eceProcessConfig = proc "detect-doggies" []
333+
, eceStdout = fromString "puppy"
334+
, eceStderr = fromString "doggy"
335+
}
336+
show exitCodeException `shouldBe`
337+
"Received ExitFailure 1 when running\n"
338+
++ "Raw command: detect-doggies\n"
339+
++ "\n"
340+
++ "Standard output:\n"
341+
++ "puppy\n"
342+
++ "Standard error:\n"
343+
++ "doggy"

0 commit comments

Comments
 (0)