codemonitor-0.2: src/Job.hs

module Job where

import Control.Concurrent
import Job.Types
import System.Exit
import System.Process
import Text.Regex.Posix

type Signaller = String -> Status -> String -> IO ()

runAllJobs :: Signaller -> Jobs -> IO Jobs
runAllJobs signalResult (Jobs jobs) = fmap Jobs (mapM (reRunJob signalResult) jobs)

reRunJobs :: FilePath -> Signaller -> Jobs -> IO Jobs
reRunJobs fileChanged signalResult (Jobs jobs) = fmap Jobs (mapM reRunIfMatch jobs)
    where
        reRunIfMatch job =
            if fileChanged =~ matchExpr job
                then reRunJob signalResult job
                else return job

reRunJob :: Signaller -> Job -> IO Job
reRunJob signalResult job = do
    cancel job
    -- NOTE: signalResult must be called asynchronoulsy, otherwise the lock for
    -- jobsRef will deadlock.
    threadId <- forkIO $ runThread job signalResult
    return $ job { thread = Just threadId, status = Working, output = "" }

cancel :: Job -> IO ()
cancel Job { thread = Just id } = killThread id
cancel _                        = return ()

runThread :: Job -> Signaller -> IO ()
runThread job signalResult = do
    -- NOTE: Is the process killed if this thread is killed? If not, is that
    -- the reason why we get resource exhaustion sometimes?
    (exit, stdout, stderr) <- readProcessWithExitCode (name job) (args job) ""
    if exit == ExitSuccess
        then signalResult (jobId job) Idle (stderr ++ stdout)
        else signalResult (jobId job) Fail (stderr ++ stdout)

updateJobStatus :: String -> Status -> String -> Jobs -> Jobs
updateJobStatus theId status newOutput (Jobs jobs) = Jobs (map updateJobInner jobs)
    where
        updateJobInner job
            | jobId job == theId = job { status = status
                                       , thread = Nothing
                                       , output = output job ++ newOutput
                                       }
            | otherwise          = job