free-theorems-seq-webui-1.0: src/TimeOut.hs

module TimeOut where

import Control.Concurrent
--import Distribution.Simple.Utils
watchdogIO :: (Show a) =>
                Int  -- milliseconds
             -> IO a   -- expensive computation
             -> IO a   -- cheap computation
             -> IO a
watchdogIO millis expensive cheap = 
    do mvar <- newEmptyMVar
       tid1 <- forkIO $ do x <- expensive
	                   (if (length (show x) >= 0) then x else x) `seq` putMVar mvar (Just x)
       tid2 <- forkIO $ do threadDelay (millis * 1000)
                           putMVar mvar Nothing
       res <- takeMVar mvar
       case res of
           Just x -> 
               do --info ("EXPENSIVE was used")
                  killThread tid2 --`catch` (\e -> warn (show e))
                  return x
           Nothing ->
               do --info ("WATCHDOG after " ++ show millis ++ " milliseconds")
                  killThread tid1 --`catch` (\e -> warn (show e))
                  cheap

watchdog1 :: (Show a) => Int -> a -> IO (Maybe a)
watchdog1 millis x =
    watchdogIO millis (return (Just x))
                      (return Nothing)

watchdog2 :: (Show a) => Int -> a -> IO (Maybe a)
watchdog2 millis x =
    watchdogIO millis (x `seq` return (Just x))
                      (return Nothing)