Revision ea7032da src/Ganeti/JQueue.hs
| b/src/Ganeti/JQueue.hs | ||
|---|---|---|
| 71 | 71 |
import Control.Concurrent.MVar |
| 72 | 72 |
import Control.Exception |
| 73 | 73 |
import Control.Monad |
| 74 |
import Control.Monad.IO.Class |
|
| 74 | 75 |
import Data.Functor ((<$)) |
| 75 | 76 |
import Data.List |
| 76 | 77 |
import Data.Maybe |
| ... | ... | |
| 338 | 339 |
else return [] |
| 339 | 340 |
return $ rootdir:other |
| 340 | 341 |
|
| 341 |
-- Function equivalent to the \'sequence\' function, that cannot be used because |
|
| 342 |
-- of library version conflict on Lucid. |
|
| 343 |
-- FIXME: delete this and just use \'sequence\' instead when Lucid compatibility |
|
| 344 |
-- will not be required anymore. |
|
| 345 |
sequencer :: [Either IOError [JobId]] -> Either IOError [[JobId]] |
|
| 346 |
sequencer l = fmap reverse $ foldl seqFolder (Right []) l |
|
| 347 |
|
|
| 348 |
-- | Folding function for joining multiple [JobIds] into one list. |
|
| 349 |
seqFolder :: Either IOError [[JobId]] |
|
| 350 |
-> Either IOError [JobId] |
|
| 351 |
-> Either IOError [[JobId]] |
|
| 352 |
seqFolder (Left e) _ = Left e |
|
| 353 |
seqFolder (Right _) (Left e) = Left e |
|
| 354 |
seqFolder (Right l) (Right el) = Right $ el:l |
|
| 355 |
|
|
| 356 | 342 |
-- | Computes the list of all jobs in the given directories. |
| 357 |
getJobIDs :: [FilePath] -> IO (Either IOError [JobId])
|
|
| 358 |
getJobIDs paths = liftM (fmap concat . sequencer) (mapM getDirJobIDs paths)
|
|
| 343 |
getJobIDs :: [FilePath] -> IO (GenericResult IOError [JobId])
|
|
| 344 |
getJobIDs = runResultT . liftM concat . mapM getDirJobIDs
|
|
| 359 | 345 |
|
| 360 | 346 |
-- | Sorts the a list of job IDs. |
| 361 | 347 |
sortJobIDs :: [JobId] -> [JobId] |
| 362 | 348 |
sortJobIDs = sortBy (comparing fromJobId) |
| 363 | 349 |
|
| 364 | 350 |
-- | Computes the list of jobs in a given directory. |
| 365 |
getDirJobIDs :: FilePath -> IO (Either IOError [JobId]) |
|
| 366 |
getDirJobIDs path = do |
|
| 367 |
either_contents <- |
|
| 368 |
try (getDirectoryContents path) :: IO (Either IOError [FilePath]) |
|
| 369 |
case either_contents of |
|
| 370 |
Left e -> do |
|
| 371 |
logWarning $ "Failed to list job directory " ++ path ++ ": " ++ show e |
|
| 372 |
return $ Left e |
|
| 373 |
Right contents -> do |
|
| 374 |
let jids = foldl (\ids file -> |
|
| 375 |
case parseJobFileId file of |
|
| 376 |
Nothing -> ids |
|
| 377 |
Just new_id -> new_id:ids) [] contents |
|
| 378 |
return . Right $ reverse jids |
|
| 351 |
getDirJobIDs :: FilePath -> ResultT IOError IO [JobId] |
|
| 352 |
getDirJobIDs path = |
|
| 353 |
withErrorLogAt WARNING ("Failed to list job directory " ++ path) .
|
|
| 354 |
liftM (mapMaybe parseJobFileId) $ liftIO (getDirectoryContents path) |
|
| 379 | 355 |
|
| 380 | 356 |
-- | Reads the job data from disk. |
| 381 | 357 |
readJobDataFromDisk :: FilePath -> Bool -> JobId -> IO (Maybe (String, Bool)) |
Also available in: Unified diff