module System.SelfRestart
(
selfRestart
, forkSelfRestartExePoll
, forkSelfRestartExePollWithAction
) where
import Control.Applicative
import Control.Concurrent
import Control.Monad
import System.Posix.Process (executeFile)
import System.Directory (getModificationTime)
import System.Environment.Executable (getExecutablePath, getScriptPath, ScriptPath (..))
import GHC.Environment (getFullArgs)
selfRestart :: IO ()
selfRestart = do
realExePath <- getExecutablePath
scriptPath <- getScriptPath
fullArgs <- getFullArgs
case scriptPath of
Executable p -> restart p fullArgs
RunGHC _ -> restart realExePath fullArgs
Interactive -> return ()
where
restart exePath args = executeFile exePath False args Nothing
forkSelfRestartExePoll :: Double -> IO (Maybe ThreadId)
forkSelfRestartExePoll pollSeconds = forkSelfRestartExePollWithAction pollSeconds (return ())
forkSelfRestartExePollWithAction :: Double -> IO () -> IO (Maybe ThreadId)
forkSelfRestartExePollWithAction pollSeconds shutdownAction = do
when (pollTimeoutUs < 0) $ error $ "forkSelfRestartExePollWithAction: Bad poll timeout: " ++ show pollSeconds
realExePath <- getExecutablePath
scriptPath <- getScriptPath
fullArgs <- getFullArgs
case scriptPath of
Executable p -> Just <$> spawn p p fullArgs
RunGHC p -> Just <$> spawn p realExePath fullArgs
Interactive -> return Nothing
where
pollTimeoutUs = floor $ pollSeconds * 1000000
spawn watchPath exePath args = do
mtimeStarted <- getModificationTime watchPath
forkIO $
forever $ do
threadDelay pollTimeoutUs
mtime <- getModificationTime watchPath
when (mtime > mtimeStarted) $ do
shutdownAction
executeFile exePath False args Nothing