summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-28 22:43:51 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-28 22:43:51 -0400
commitda9cd315beb03570b96f83063a39e799fe01b166 (patch)
tree61fdc79dd54dccf1792cf3ccadcc584e0119d077 /Annex
parent2b3c120506f1f25b4c3d0e19342b9826bde0b3b5 (diff)
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.
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs17
1 files changed, 8 insertions, 9 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index f5571b54a..90bde2975 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -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