{-# 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. 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
$cto :: forall x. Rep TimedOut x -> TimedOut
$cfrom :: forall x. TimedOut -> Rep TimedOut x
Generic, TimedOut -> TimedOut -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimedOut -> TimedOut -> Bool
$c/= :: TimedOut -> TimedOut -> Bool
== :: TimedOut -> TimedOut -> Bool
$c== :: TimedOut -> TimedOut -> Bool
Eq, Int -> TimedOut -> ShowS
[TimedOut] -> ShowS
TimedOut -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimedOut] -> ShowS
$cshowList :: [TimedOut] -> ShowS
show :: TimedOut -> String
$cshow :: TimedOut -> String
showsPrec :: Int -> TimedOut -> ShowS
$cshowsPrec :: Int -> TimedOut -> ShowS
Show)

maybeWaitForProcess
  :: ProcessHandle
  -> IO (Maybe ExitCode)
maybeWaitForProcess :: ProcessHandle -> IO (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess =
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (ProcessHandle -> IO ExitCode
IO.waitForProcess ProcessHandle
hProcess)) forall a b. (a -> b) -> a -> b
$ \(AsyncCancelled
_ :: AsyncCancelled) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a b. IO a -> IO b -> IO (Either a b)
IO.race
  (Int -> IO ()
IO.threadDelay (Int
seconds forall a. Num a => a -> a -> a
* Int
1000000) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return TimedOut
TimedOut)
  (ProcessHandle -> IO (Maybe ExitCode)
maybeWaitForProcess ProcessHandle
hProcess)