module Mueval.Parallel where

import Prelude hiding (catch)
import Control.Concurrent   (forkIO, killThread, myThreadId, threadDelay, throwTo, ThreadId)
import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))
import Control.Exception.Extensible (ErrorCall(..),SomeException,catch)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))

import Mueval.Interpreter
import Mueval.ArgsParse

-- | Fork off a thread which will sleep and then kill off the specified thread.
watchDog :: Int -> ThreadId -> IO ()
watchDog tout tid = do _ <- installHandler sigXCPU
                                          (CatchOnce
                                           $ throwTo tid $ ErrorCall "Time limit exceeded.") Nothing
                       _ <- forkIO $ do
                                   threadDelay (tout * 700000)
                                   -- Time's up. It's a good day to die.
                                   throwTo tid (ErrorCall "Time limit exceeded")
                                   killThread tid -- Die now, srsly.
                                   error "Time expired"
                       return () -- Never reached. Either we error out here
                                 -- or the evaluation thread finishes.

-- | A basic blocking operation.
block :: (t -> MVar a -> IO t1) -> t -> IO a
block f opts = do  mvar <- newEmptyMVar
                   _ <- f opts mvar
                   takeMVar mvar -- block until ErrorCall, or forkedMain succeeds

-- | Using MVars, block on forkedMain' until it finishes.
forkedMain :: Options -> IO ()
forkedMain opts = block forkedMain' opts >> return ()

-- | Set a 'watchDog' on this thread, and then continue on with whatever.
forkedMain' :: Options -> MVar String -> IO ThreadId
forkedMain' opts mvar = do mainId <- myThreadId
                           watchDog (timeLimit opts) mainId
                           hSetBuffering stdout NoBuffering

                           -- Our modules and expression are set up. Let's do stuff.
                           forkIO $ (interpreterSession (checkImport opts)
                                                            >> putMVar mvar "Done.")
                                      `catch` \e -> throwTo mainId (e::SomeException)
                                                             -- bounce exceptions to the main thread,
                                                             -- so they are reliably printed out
          where checkImport x = if noImports x then x{modules=Nothing} else x