Kill process when it does not terminate within a second

1 files changed, 4 insertions, 0 deletions

diff --git a/src/Process.hs b/src/Process.hs
index 8548e73..a1a421f 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -9,6 +9,7 @@ module Process (
 ) where
 
 import Control.Arrow
+import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Monad.Except
 
@@ -89,6 +90,9 @@ closeProcess p = do
             Nothing -> return ()
             Just pid -> signalProcess sig pid
 
+    liftIO $ void $ forkIO $ do
+        threadDelay 1000000
+        terminateProcess $ procHandle p
     liftIO (waitForProcess (procHandle p)) >>= \case
         ExitSuccess -> return ()
         ExitFailure code -> do