LGTM, thanks.
On Wed, Feb 5, 2014 at 2:49 PM, Klaus Aehlig <[email protected]> wrote: > There is a separation of responsibilities here. For jobs still > in the queue, it is the responsibility of the queue (scheduler), > for started jobs, the job itself has to take care of it. To avoid > the job transitioning inbetween, it is temporarily dequeued during > the operation. The operation changes the file on master, while > leaving the replication to the caller. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/JQScheduler.hs | 20 ++++++++++++++++++++ > 1 file changed, 20 insertions(+) > > diff --git a/src/Ganeti/JQScheduler.hs b/src/Ganeti/JQScheduler.hs > index 8359605..50bc4a2 100644 > --- a/src/Ganeti/JQScheduler.hs > +++ b/src/Ganeti/JQScheduler.hs > @@ -29,12 +29,14 @@ module Ganeti.JQScheduler > , initJQScheduler > , enqueueNewJobs > , dequeueJob > + , setJobPriority > ) where > > import Control.Arrow > import Control.Concurrent > import Control.Exception > import Control.Monad > +import Control.Monad.IO.Class > import Data.Function (on) > import Data.List > import Data.Maybe > @@ -330,3 +332,21 @@ dequeueJob state jid = do > logDebug $ "Result of dequeing job " ++ show (fromJobId jid) > ++ " is " ++ show result' > return result' > + > +-- | Change the priority of a queued job (once the job is handed over > +-- to execution, the job itself needs to be informed). To avoid the > +-- job being started unmodified, it is temporarily unqueued during the > +-- change. Return the modified job, if the job's priority was sucessfully > +-- modified, Nothing, if the job already started, and a Bad value, if the > job > +-- is unkown. > +setJobPriority :: JQStatus -> JobId -> Int -> IO (Result (Maybe > QueuedJob)) > +setJobPriority state jid prio = runResultT $ do > + maybeJob <- mkResultT . atomicModifyIORef (jqJobs state) $ rmJob jid > + case maybeJob of > + Nothing -> return Nothing > + Just job -> do > + let job' = changeJobPriority prio job > + qDir <- liftIO queueDir > + mkResultT $ writeJobToDisk qDir job' > + liftIO $ enqueueNewJobs state [job'] > + return $ Just job' > -- > 1.9.0.rc1.175.g0b1dcb5 > >
