Fix cleanup when stdin/stdout handles are inherited and are Nothing

Author: pranaysashank

src/Streamly/Internal/System/Process.hs

@@ -518,7 +518,7 @@ cleanupNormal (_, _, _, procHandle) = do
 -- still hanging around.
 cleanupException ::
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
-cleanupException (Just stdinH, Just stdoutH, stderrMaybe, ph) = do
+cleanupException (stdinMaybe, stdoutMaybe, stderrMaybe, ph) = do
     -- Send a SIGTERM to the process
 #ifdef USE_NATIVE
     terminate ph
@@ -529,8 +529,8 @@ cleanupException (Just stdinH, Just stdoutH, stderrMaybe, ph) = do
     -- Ideally we should be closing the handle without flushing the buffers so
     -- that we cannot get a SIGPIPE. But there seems to be no way to do that as
     -- of now so we just ignore the SIGPIPE.
-    hClose stdinH `catch` eatSIGPIPE
-    hClose stdoutH
+    whenJust (\stdinH -> hClose stdinH `catch` eatSIGPIPE) stdinMaybe
+    whenJust hClose stdoutMaybe
     whenJust hClose stderrMaybe
 
     -- Non-blocking wait for the process to go away
@@ -553,7 +553,6 @@ cleanupException (Just stdinH, Just stdoutH, stderrMaybe, ph) = do
             _ -> False
 
     eatSIGPIPE e = unless (isSIGPIPE e) $ throwIO e
-cleanupException _ = error "cleanupProcess: Not reachable"
 
 -- | Creates a system process from an executable path and arguments. For the
 -- default attributes used to create the process see 'mkConfig'.
@@ -633,11 +632,10 @@ pipeChunksEitherWith modifier path args input =
 
     where
 
-    run (Just stdinH, Just stdoutH, Just stderrH, _) =
-        putChunksClose stdinH input
-            `parallel` fmap Left (toChunksClose stderrH)
-            `parallel` fmap Right (toChunksClose stdoutH)
-    run _ = error "pipeChunksEitherWith: Not reachable"
+    run (stdinMaybe, stdoutMaybe, stderrMaybe, _) =
+        whenJustS (`putChunksClose` input) stdinMaybe
+            `parallel` fmap Left (whenJustS toChunksClose stderrMaybe)
+            `parallel` fmap Right (whenJustS toChunksClose stdoutMaybe)
 
 -- | Like 'pipeChunks' but also includes stderr as 'Left' stream in the
 -- 'Either' output.
@@ -706,9 +704,9 @@ pipeChunksWith modifier path args input =
 
     where
 
-    run (Just stdinH, Just stdoutH, _, _) =
-        putChunksClose stdinH input `parallel` toChunksClose stdoutH
-    run _ = error "pipeChunksWith: Not reachable"
+    run (stdinMaybe, stdoutMaybe, _, _) =
+        whenJustS (`putChunksClose` input) stdinMaybe
+            `parallel` whenJustS toChunksClose stdoutMaybe
 
 -- | @pipeChunks file args input@ runs the executable @file@ specified by
 -- its name or path using @args@ as arguments and @input@ stream as its
@@ -855,10 +853,9 @@ toChunksEitherWith modifier path args =
 
     where
 
-    run (_, Just stdoutH, Just stderrH, _) =
-        fmap Left (toChunksClose stderrH)
-            `parallel` fmap Right (toChunksClose stdoutH)
-    run _ = error "toChunksEitherWith: Not reachable"
+    run (_, stdoutMaybe, stderrMaybe, _) =
+        fmap Left (whenJustS toChunksClose stderrMaybe)
+            `parallel` fmap Right (whenJustS toChunksClose stdoutMaybe)
 
 -- | Like 'toChunks' but use the specified configuration to run the process.
 {-# INLINE toChunksWith #-}
@@ -873,8 +870,7 @@ toChunksWith modifier path args =
 
     where
 
-    run (_, Just stdoutH, _, _) = toChunksClose stdoutH
-    run _ = error "toChunksWith: Not reachable"
+    run (_, stdoutMaybe, _, _) = whenJustS toChunksClose stdoutMaybe
 
 -- | @toBytesEither path args@ runs the executable at @path@ using @args@ as
 -- arguments and returns the output of the process as a stream of 'Either'
@@ -1181,3 +1177,7 @@ daemon modCfg path args =
                 (setSession NewSession . modCfg)
                 path args
      in fmap (either undefined id) r
+
+
+whenJustS :: Applicative m => (a -> Stream m b) -> Maybe a -> Stream m b
+whenJustS action mb = maybe Stream.nil action mb