{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hedgehog.Extras.Stock.IO.Process
  ( maybeWaitForProcess
  , waitSecondsForProcess
  , TimedOut(..)
  ) where

import           Control.Concurrent.Async
import           Control.Exception
import           Control.Monad
import           Data.Either
import           Data.Eq
import           Data.Function
import           Data.Int
import           Data.Maybe
import           GHC.Generics (Generic)
import           GHC.Num
import           System.Exit
import           System.IO
import           System.Process
import           Text.Show

import qualified Control.Concurrent as IO
import qualified Control.Concurrent.Async as IO
import qualified System.Process as IO

data TimedOut = TimedOut deriving ((forall x. TimedOut -> Rep TimedOut x)
-> (forall x. Rep TimedOut x -> TimedOut) -> Generic TimedOut
forall x. Rep TimedOut x -> TimedOut
forall x. TimedOut -> Rep TimedOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimedOut -> Rep TimedOut x
from :: forall x. TimedOut -> Rep TimedOut x
$cto :: forall x. Rep TimedOut x -> TimedOut
to :: forall x. Rep TimedOut x -> TimedOut
Generic, TimedOut -> TimedOut -> Bool
(TimedOut -> TimedOut -> Bool)
-> (TimedOut -> TimedOut -> Bool) -> Eq TimedOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimedOut -> TimedOut -> Bool
== :: TimedOut -> TimedOut -> Bool
$c/= :: TimedOut -> TimedOut -> Bool
/= :: TimedOut -> TimedOut -> Bool
Eq, Int -> TimedOut -> ShowS
[TimedOut] -> ShowS
TimedOut -> String
(Int -> TimedOut -> ShowS)
-> (TimedOut -> String) -> ([TimedOut] -> ShowS) -> Show TimedOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimedOut -> ShowS
showsPrec :: Int -> TimedOut -> ShowS
$cshow :: TimedOut -> String
show :: TimedOut -> String
$cshowList :: [TimedOut] -> ShowS
showList :: [TimedOut] -> ShowS
Show)

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
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 (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) a. Monad m => a -> m a
return TimedOut
TimedOut)
  (ProcessHandle -> IO (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess)