Revision 96d55b50 src/Ganeti/JQScheduler.hs

b/src/Ganeti/JQScheduler.hs
29 29 
  , initJQScheduler
30 30 
  , enqueueNewJobs
31 31 
  , dequeueJob
32 
  , setJobPriority
32 33 
  ) where
33 34 

  		





  34
  35
  
    
import Control.Arrow


  		





  35
  36
  
    
import Control.Concurrent


  		





  36
  37
  
    
import Control.Exception


  		





  37
  38
  
    
import Control.Monad


  		





  
  39
  
    
import Control.Monad.IO.Class


  		





  38
  40
  
    
import Data.Function (on)


  		





  39
  41
  
    
import Data.List


  		





  40
  42
  
    
import Data.Maybe


  		





  ......




  330
  332
  
    
  logDebug $ "Result of dequeing job " ++ show (fromJobId jid)


  		





  331
  333
  
    
              ++ " is " ++ show result'


  		





  332
  334
  
    
  return result'


  		





  
  335
  
    

  		





  
  336
  
    
-- | Change the priority of a queued job (once the job is handed over


  		





  
  337
  
    
-- to execution, the job itself needs to be informed). To avoid the


  		





  
  338
  
    
-- job being started unmodified, it is temporarily unqueued during the


  		





  
  339
  
    
-- change. Return the modified job, if the job's priority was sucessfully


  		





  
  340
  
    
-- modified, Nothing, if the job already started, and a Bad value, if the job


  		





  
  341
  
    
-- is unkown.


  		





  
  342
  
    
setJobPriority :: JQStatus -> JobId -> Int -> IO (Result (Maybe QueuedJob))


  		





  
  343
  
    
setJobPriority state jid prio = runResultT $ do


  		





  
  344
  
    
  maybeJob <- mkResultT . atomicModifyIORef (jqJobs state) $ rmJob jid


  		





  
  345
  
    
  case maybeJob of


  		





  
  346
  
    
    Nothing -> return Nothing


  		





  
  347
  
    
    Just job -> do


  		





  
  348
  
    
      let job' = changeJobPriority prio job


  		





  
  349
  
    
      qDir <- liftIO queueDir


  		





  
  350
  
    
      mkResultT $ writeJobToDisk qDir job'


  		





  
  351
  
    
      liftIO $ enqueueNewJobs state [job']


  		





  
  352
  
    
      return $ Just job'


  		












Also available in:
  Unified diff