module HaskellWorks.IO.Process
  ( maybeWaitForProcess,
    waitSecondsForProcess,
  ) where

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

import           Control.Applicative
import           Data.Function
import           Data.Functor
import           HaskellWorks.Error.Types
import           HaskellWorks.Prelude
import qualified System.Process           as IO
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

waitSecondsForProcess :: ()
  => Int
  -> ProcessHandle
  -> IO (Either TimedOut (Maybe ExitCode))
waitSecondsForProcess :: Int -> ProcessHandle -> IO (Either TimedOut (Maybe ExitCode))
waitSecondsForProcess Int
seconds ProcessHandle
hProcess =
  IO TimedOut
-> IO (Maybe ExitCode) -> IO (Either TimedOut (Maybe ExitCode))
forall a b. IO a -> IO b -> IO (Either a b)
IO.race
    (Int -> IO ()
IO.threadDelay (Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) IO () -> IO TimedOut -> IO TimedOut
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimedOut -> IO TimedOut
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TimedOut
TimedOut Text
"Timed out waiting for process"))
    (ProcessHandle -> IO (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess)