Commit ea7032da authored by Petr Pudlak's avatar Petr Pudlak
Browse files

Update getDirJobIDs to use ResultT



Also simplify code and remove unused functions.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent fb54b24a
......@@ -268,7 +268,7 @@ readJobsFromDisk = do
logInfo "Loading job queue"
qdir <- queueDir
eitherJids <- JQ.getJobIDs [qdir]
let jids = either (const []) JQ.sortJobIDs eitherJids
let jids = genericResult (const []) JQ.sortJobIDs eitherJids
jidsstring = commaJoin $ map (show . fromJobId) jids
logInfo $ "Non-archived jobs on disk: " ++ jidsstring
jobs <- mapM readJobFromDisk jids
......
......@@ -71,6 +71,7 @@ import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.Functor ((<$))
import Data.List
import Data.Maybe
......@@ -338,44 +339,19 @@ determineJobDirectories rootdir archived = do
else return []
return $ rootdir:other
-- Function equivalent to the \'sequence\' function, that cannot be used because
-- of library version conflict on Lucid.
-- FIXME: delete this and just use \'sequence\' instead when Lucid compatibility
-- will not be required anymore.
sequencer :: [Either IOError [JobId]] -> Either IOError [[JobId]]
sequencer l = fmap reverse $ foldl seqFolder (Right []) l
-- | Folding function for joining multiple [JobIds] into one list.
seqFolder :: Either IOError [[JobId]]
-> Either IOError [JobId]
-> Either IOError [[JobId]]
seqFolder (Left e) _ = Left e
seqFolder (Right _) (Left e) = Left e
seqFolder (Right l) (Right el) = Right $ el:l
-- | Computes the list of all jobs in the given directories.
getJobIDs :: [FilePath] -> IO (Either IOError [JobId])
getJobIDs paths = liftM (fmap concat . sequencer) (mapM getDirJobIDs paths)
getJobIDs :: [FilePath] -> IO (GenericResult IOError [JobId])
getJobIDs = runResultT . liftM concat . mapM getDirJobIDs
-- | Sorts the a list of job IDs.
sortJobIDs :: [JobId] -> [JobId]
sortJobIDs = sortBy (comparing fromJobId)
-- | Computes the list of jobs in a given directory.
getDirJobIDs :: FilePath -> IO (Either IOError [JobId])
getDirJobIDs path = do
either_contents <-
try (getDirectoryContents path) :: IO (Either IOError [FilePath])
case either_contents of
Left e -> do
logWarning $ "Failed to list job directory " ++ path ++ ": " ++ show e
return $ Left e
Right contents -> do
let jids = foldl (\ids file ->
case parseJobFileId file of
Nothing -> ids
Just new_id -> new_id:ids) [] contents
return . Right $ reverse jids
getDirJobIDs :: FilePath -> ResultT IOError IO [JobId]
getDirJobIDs path =
withErrorLogAt WARNING ("Failed to list job directory " ++ path) .
liftM (mapMaybe parseJobFileId) $ liftIO (getDirectoryContents path)
-- | Reads the job data from disk.
readJobDataFromDisk :: FilePath -> Bool -> JobId -> IO (Maybe (String, Bool))
......
......@@ -299,9 +299,9 @@ queryJobs cfg live fields qfilter =
lift (determineJobDirectories rootdir want_arch
>>= getJobIDs)
case maybeJobIDs of
Left e -> (toError . Bad) . BlockDeviceError $
Bad e -> (toError . Bad) . BlockDeviceError $
"Unable to fetch the job list: " ++ show e
Right jobIDs -> toError . Ok $ sortJobIDs jobIDs
Ok jobIDs -> toError . Ok $ sortJobIDs jobIDs
-- else we shouldn't look at the filesystem...
else return []
Ok v -> toError $ Ok v
......
......@@ -361,10 +361,10 @@ handleCall qlock _ cfg (ArchiveJob jid) = do
handleCall qlock _ cfg (AutoArchiveJobs age timeout) = do
qDir <- queueDir
eitherJids <- getJobIDs [qDir]
case eitherJids of
Left s -> return . Bad . JobQueueError $ show s
Right jids -> do
resultJids <- getJobIDs [qDir]
case resultJids of
Bad s -> return . Bad . JobQueueError $ show s
Ok jids -> do
result <- bracket_ (takeMVar qlock) (putMVar qlock ())
. archiveJobs cfg age timeout
$ sortJobIDs jids
......
......@@ -176,15 +176,8 @@ case_JobStatusPri_py_equiv = do
-- | Tests listing of Job ids.
prop_ListJobIDs :: Property
prop_ListJobIDs = monadicIO $ do
let extractJobIDs jIDs = do
either_jobs <- jIDs
case either_jobs of
Right j -> return j
Left e -> fail $ show e
isLeft e =
case e of
Left _ -> True
_ -> False
let extractJobIDs :: (Show e, Monad m) => m (GenericResult e a) -> m a
extractJobIDs = (>>= genericResult (fail . show) return)
jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l))
(e, f, g) <-
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do
......@@ -196,7 +189,7 @@ prop_ListJobIDs = monadicIO $ do
stop $ conjoin [ printTestCase "empty directory" $ e ==? []
, printTestCase "directory with valid names" $
f ==? sortJobIDs jobs
, printTestCase "invalid directory" $ isLeft g
, printTestCase "invalid directory" $ isBad g
]
-- | Tests loading jobs from disk.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment