codemonitor-0.1: src/Job.hs

module Job where

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

data Jobs = Jobs [Job]

createJobs :: [Job] -> Jobs
createJobs = Jobs

jobWithId :: Jobs -> String -> Job
jobWithId (Jobs jobs) id = find jobs
    where
        find [] = error "gaaah"
        find (x:xs) | jobId x == id = x
                    | otherwise     = find xs

data Job = Job
    { jobId     :: String
    , name      :: String
    , args      :: [String]
    , matchExpr :: String
    , status    :: Status
    , thread    :: Maybe ThreadId
    }

data Status = Idle | Working | Fail String deriving (Eq)

fullName :: Job -> String
fullName (Job { name = name, args = args }) = name ++ " " ++ unwords args

processJob :: String -> String -> [String] -> String -> Job
processJob jobId name args expr = Job jobId name args expr Idle Nothing

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

reRunJobs :: FilePath -> (String -> Status -> IO ()) -> 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 :: (String -> Status -> IO ()) -> 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 }

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

runThread :: Job -> (String -> Status -> IO ()) -> 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
        else signalResult (jobId job) (Fail $ stderr ++ stdout)

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