add support for using hashDirLower in addition to hashDirMixed

Supporting multiple directory hash types will allow converting to a
different one, without a flag day.

gitAnnexLocation now checks which of the possible locations have a file.
This means more statting of files. Several places currently use
gitAnnexLocation and immediately check if the returned file exists;
those need to be optimised.
This commit is contained in:
Joey Hess 2011-11-28 22:43:51 -04:00
parent 2b3c120506
commit da9cd315be
15 changed files with 73 additions and 44 deletions

View file

@ -43,12 +43,12 @@ import Annex.Exception
{- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool
inAnnex = inAnnex' doesFileExist
inAnnex = inAnnex' $ doesFileExist
inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
inAnnex' a key = do
whenM (fromRepo Git.repoIsUrl) $
error "inAnnex cannot check remote repo"
inRepo $ a . gitAnnexLocation key
inRepo $ \g -> gitAnnexLocation key g >>= a
{- A safer check; the key's content must not only be present, but
- is not in the process of being removed. -}
@ -70,7 +70,7 @@ inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check
- it. (If the content is not present, no locking is done.) -}
lockContent :: Key -> Annex a -> Annex a
lockContent key a = do
file <- fromRepo $ gitAnnexLocation key
file <- inRepo $ gitAnnexLocation key
bracketIO (openForLock file True >>= lock) unlock a
where
lock Nothing = return Nothing
@ -100,9 +100,8 @@ calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
cwd <- liftIO getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPath cwd file
top <- fromRepo Git.workTree
return $ relPathDirToFile (parentDir absfile)
top </> ".git" </> annexLocation key
loc <- inRepo $ gitAnnexLocation key
return $ relPathDirToFile (parentDir absfile) loc
where
whoops = error $ "unable to normalize " ++ file
@ -213,7 +212,7 @@ checkDiskSpace' adjustment key = do
-}
moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do
dest <- fromRepo $ gitAnnexLocation key
dest <- inRepo $ gitAnnexLocation key
let dir = parentDir dest
e <- liftIO $ doesFileExist dest
if e
@ -227,7 +226,7 @@ moveAnnex key src = do
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
withObjectLoc key a = do
file <- fromRepo $gitAnnexLocation key
file <- inRepo $ gitAnnexLocation key
let dir = parentDir file
a (dir, file)
@ -250,7 +249,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
- returns the file it was moved to. -}
moveBad :: Key -> Annex FilePath
moveBad key = do
src <- fromRepo $ gitAnnexLocation key
src <- inRepo $ gitAnnexLocation key
bad <- fromRepo gitAnnexBadDir
let dest = bad </> takeFileName src
liftIO $ do