fix getKeyspresent to work with hashed dirs
This commit is contained in:
parent
a080799900
commit
744638197f
1 changed files with 12 additions and 4 deletions
16
Content.hs
16
Content.hs
|
@ -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 /= ".."
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue