Revision be0cb2d7
b/src/Ganeti/JQueue.hs | ||
---|---|---|
231 | 231 |
return $ rootdir:other |
232 | 232 |
|
233 | 233 |
-- | Computes the list of all jobs in the given directories. |
234 |
getJobIDs :: [FilePath] -> IO [JobId]
|
|
235 |
getJobIDs = liftM concat . mapM getDirJobIDs
|
|
234 |
getJobIDs :: [FilePath] -> IO (Either IOError [JobId])
|
|
235 |
getJobIDs paths = liftM (fmap concat . sequence) (mapM getDirJobIDs paths)
|
|
236 | 236 |
|
237 | 237 |
-- | Sorts the a list of job IDs. |
238 | 238 |
sortJobIDs :: [JobId] -> [JobId] |
239 | 239 |
sortJobIDs = sortBy (comparing fromJobId) |
240 | 240 |
|
241 | 241 |
-- | Computes the list of jobs in a given directory. |
242 |
getDirJobIDs :: FilePath -> IO [JobId]
|
|
242 |
getDirJobIDs :: FilePath -> IO (Either IOError [JobId])
|
|
243 | 243 |
getDirJobIDs path = do |
244 |
contents <- getDirectoryContents path `Control.Exception.catch` |
|
245 |
ignoreIOError [] False |
|
246 |
("Failed to list job directory " ++ path) |
|
247 |
let jids = foldl (\ids file -> |
|
248 |
case parseJobFileId file of |
|
249 |
Nothing -> ids |
|
250 |
Just new_id -> new_id:ids) [] contents |
|
251 |
return $ reverse jids |
|
244 |
either_contents <- |
|
245 |
try (getDirectoryContents path) :: IO (Either IOError [FilePath]) |
|
246 |
case either_contents of |
|
247 |
Left e -> do |
|
248 |
logWarning $ "Failed to list job directory " ++ path ++ ": " ++ show e |
|
249 |
return $ Left e |
|
250 |
Right contents -> do |
|
251 |
let jids = foldl (\ids file -> |
|
252 |
case parseJobFileId file of |
|
253 |
Nothing -> ids |
|
254 |
Just new_id -> new_id:ids) [] contents |
|
255 |
return . Right $ reverse jids |
|
252 | 256 |
|
253 | 257 |
-- | Reads the job data from disk. |
254 | 258 |
readJobDataFromDisk :: FilePath -> Bool -> JobId -> IO (Maybe (String, Bool)) |
b/src/Ganeti/Query/Query.hs | ||
---|---|---|
53 | 53 |
) where |
54 | 54 |
|
55 | 55 |
import Control.DeepSeq |
56 |
import Control.Monad (filterM, liftM, foldM)
|
|
56 |
import Control.Monad (filterM, foldM) |
|
57 | 57 |
import Control.Monad.Trans (lift) |
58 | 58 |
import Data.List (intercalate) |
59 | 59 |
import Data.Maybe (fromMaybe) |
... | ... | |
218 | 218 |
Bad msg -> resultT . Bad $ GenericError msg |
219 | 219 |
Ok [] -> if live |
220 | 220 |
-- we can check the filesystem for actual jobs |
221 |
then lift $ liftM sortJobIDs |
|
222 |
(determineJobDirectories rootdir want_arch >>= |
|
223 |
getJobIDs) |
|
221 |
then do |
|
222 |
maybeJobIDs <- |
|
223 |
lift (determineJobDirectories rootdir want_arch |
|
224 |
>>= getJobIDs) |
|
225 |
case maybeJobIDs of |
|
226 |
Left e -> (resultT . Bad) . BlockDeviceError $ |
|
227 |
"Unable to fetch the job list: " ++ show e |
|
228 |
Right jobIDs -> resultT . Ok $ sortJobIDs jobIDs |
|
224 | 229 |
-- else we shouldn't look at the filesystem... |
225 | 230 |
else return [] |
226 | 231 |
Ok v -> resultT $ Ok v |
b/test/hs/Test/Ganeti/JQueue.hs | ||
---|---|---|
176 | 176 |
-- | Tests listing of Job ids. |
177 | 177 |
prop_ListJobIDs :: Property |
178 | 178 |
prop_ListJobIDs = monadicIO $ do |
179 |
let extractJobIDs jIDs = do |
|
180 |
either_jobs <- jIDs |
|
181 |
case either_jobs of |
|
182 |
Right j -> return j |
|
183 |
Left e -> fail $ show e |
|
184 |
isLeft e = |
|
185 |
case e of |
|
186 |
Left _ -> True |
|
187 |
_ -> False |
|
179 | 188 |
jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l)) |
180 | 189 |
(e, f, g) <- |
181 | 190 |
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
182 |
empty_dir <- getJobIDs [tempdir] |
|
191 |
empty_dir <- extractJobIDs $ getJobIDs [tempdir]
|
|
183 | 192 |
mapM_ (\jid -> writeFile (tempdir </> jobFileName jid) "") jobs |
184 |
full_dir <- getJobIDs [tempdir] |
|
193 |
full_dir <- extractJobIDs $ getJobIDs [tempdir]
|
|
185 | 194 |
invalid_dir <- getJobIDs [tempdir </> "no-such-dir"] |
186 | 195 |
return (empty_dir, sortJobIDs full_dir, invalid_dir) |
187 | 196 |
stop $ conjoin [ printTestCase "empty directory" $ e ==? [] |
188 | 197 |
, printTestCase "directory with valid names" $ |
189 | 198 |
f ==? sortJobIDs jobs |
190 |
, printTestCase "invalid directory" $ g ==? []
|
|
199 |
, printTestCase "invalid directory" $ isLeft g
|
|
191 | 200 |
] |
192 | 201 |
|
193 | 202 |
-- | Tests loading jobs from disk. |
Also available in: Unified diff