/ - Diff - ganeti-local - Greek Research and Technology Network's projects

       return $ rootdir:other
     -- | Computes the list of all jobs in the given directories.
     getJobIDs :: [FilePath] -> IO [JobId]
     getJobIDs = liftM concat . mapM getDirJobIDs
     getJobIDs :: [FilePath] -> IO (Either IOError [JobId])
     getJobIDs paths = liftM (fmap concat . sequence) (mapM getDirJobIDs paths)
     -- | 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 [JobId]
     getDirJobIDs :: FilePath -> IO (Either IOError [JobId])
     getDirJobIDs path = do
       contents <- getDirectoryContents path `Control.Exception.catch`
                     ignoreIOError [] False
                       ("Failed to list job directory " ++ path)
       let jids = foldl (\ids file ->
                           case parseJobFileId file of
                             Nothing -> ids
                             Just new_id -> new_id:ids) [] contents
       return $ reverse jids
       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
     -- | Reads the job data from disk.
     readJobDataFromDisk :: FilePath -> Bool -> JobId -> IO (Maybe (String, Bool))

         ) where
     import Control.DeepSeq
     import Control.Monad (filterM, liftM, foldM)
     import Control.Monad (filterM, foldM)
     import Control.Monad.Trans (lift)
     import Data.List (intercalate)
     import Data.Maybe (fromMaybe)
-...
                  Bad msg -> resultT . Bad $ GenericError msg
                  Ok [] -> if live
                             -- we can check the filesystem for actual jobs
                             then lift $ liftM sortJobIDs
                                  (determineJobDirectories rootdir want_arch >>=
                                   getJobIDs)
                             then do
                               maybeJobIDs <-
                                 lift (determineJobDirectories rootdir want_arch
                                   >>= getJobIDs)
                               case maybeJobIDs of
                                 Left e -> (resultT . Bad) . BlockDeviceError $
                                   "Unable to fetch the job list: " ++ show e
                                 Right jobIDs -> resultT . Ok $ sortJobIDs jobIDs
                             -- else we shouldn't look at the filesystem...
                             else return []
                  Ok v -> resultT $ Ok v

     -- | 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
       jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l))
       (e, f, g) <-
         run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do
         empty_dir <- getJobIDs [tempdir]
         empty_dir <- extractJobIDs $ getJobIDs [tempdir]
         mapM_ (\jid -> writeFile (tempdir </> jobFileName jid) "") jobs
         full_dir <- getJobIDs [tempdir]
         full_dir <- extractJobIDs $ getJobIDs [tempdir]
         invalid_dir <- getJobIDs [tempdir </> "no-such-dir"]
         return (empty_dir, sortJobIDs full_dir, invalid_dir)
       stop $ conjoin [ printTestCase "empty directory" $ e ==? []
                      , printTestCase "directory with valid names" $
                        f ==? sortJobIDs jobs
                      , printTestCase "invalid directory" $ g ==? []
                      , printTestCase "invalid directory" $ isLeft g
+                     ]
     -- | Tests loading jobs from disk.

Synnefo » snf-ganeti » ganeti-local

Revision be0cb2d7