module HaskellWorks.IO.Process
  ( maybeWaitForProcess
  ) where

import qualified Control.Concurrent       as IO
import           Control.Concurrent.Async
import qualified Control.Concurrent.Async as IO
import qualified Control.Exception        as IO
import           Data.Maybe
import           System.Exit
import           System.IO
import qualified System.Process           as IO

import           Control.Applicative
import           Data.Function
import           Data.Functor
import           GHC.Stack                (HasCallStack, withFrozenCallStack)
import           System.Process

maybeWaitForProcess :: ()
  => ProcessHandle
  -> IO (Maybe ExitCode)
maybeWaitForProcess :: ProcessHandle -> IO (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess =
  IO (Maybe ExitCode)
-> (AsyncCancelled -> IO (Maybe ExitCode)) -> IO (Maybe ExitCode)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
IO.catch ((ExitCode -> Maybe ExitCode) -> IO ExitCode -> IO (Maybe ExitCode)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just (ProcessHandle -> IO ExitCode
IO.waitForProcess ProcessHandle
hProcess)) ((AsyncCancelled -> IO (Maybe ExitCode)) -> IO (Maybe ExitCode))
-> (AsyncCancelled -> IO (Maybe ExitCode)) -> IO (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ \(AsyncCancelled
_ :: AsyncCancelled) -> Maybe ExitCode -> IO (Maybe ExitCode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ExitCode
forall a. Maybe a
Nothing