fix getKeyspresent to work with hashed dirs

This commit is contained in:
Joey Hess 2011-03-16 11:27:29 -04:00
parent a080799900
commit 744638197f

View file

@ -161,13 +161,21 @@ getKeysPresent' dir = do
if (not exists) if (not exists)
then return [] then return []
else do else do
contents <- liftIO $ getDirectoryContents dir -- 2 levels of hashing
files <- liftIO $ filterM present contents levela <- liftIO $ subdirContent dir
return $ catMaybes $ map fileKey files levelb <- liftIO $ mapM subdirContent levela
contents <- liftIO $ mapM subdirContent (concat levelb)
files <- liftIO $ filterM present (concat contents)
return $ catMaybes $ map (fileKey . takeFileName) files
where where
present d = do present d = do
result <- try $ result <- try $
getFileStatus $ dir ++ "/" ++ d ++ "/" ++ takeFileName d getFileStatus $ d </> takeFileName d
liftIO $ putStrLn $ "trying " ++ (d </> takeFileName d)
case result of case result of
Right s -> return $ isRegularFile s Right s -> return $ isRegularFile s
Left _ -> return False Left _ -> return False
subdirContent d = do
c <- getDirectoryContents d
return $ map (d </>) $ filter notcruft c
notcruft f = f /= "." && f /= ".."