Fix direct mode mapping code to always store direct mode filenames relative to the top of the repository, even when operating inside a subdirectory.
This commit is contained in:
parent
299aeca177
commit
bbf0e74f72
3 changed files with 26 additions and 11 deletions
|
@ -29,7 +29,7 @@ import Logs.Location
|
||||||
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
|
|
||||||
{- Files in the tree that are associated with a key. -}
|
{- Absolute FilePaths of Files in the tree that are associated with a key. -}
|
||||||
associatedFiles :: Key -> Annex [FilePath]
|
associatedFiles :: Key -> Annex [FilePath]
|
||||||
associatedFiles key = do
|
associatedFiles key = do
|
||||||
files <- associatedFilesRelative key
|
files <- associatedFilesRelative key
|
||||||
|
@ -44,7 +44,7 @@ associatedFilesRelative key = do
|
||||||
liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
|
liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
|
||||||
|
|
||||||
{- Changes the associated files information for a key, applying a
|
{- Changes the associated files information for a key, applying a
|
||||||
- transformation to the list. Returns a copy of the new info. -}
|
- transformation to the list. Returns new associatedFiles value. -}
|
||||||
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
|
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
|
||||||
changeAssociatedFiles key transform = do
|
changeAssociatedFiles key transform = do
|
||||||
mapping <- inRepo $ gitAnnexMapping key
|
mapping <- inRepo $ gitAnnexMapping key
|
||||||
|
@ -52,22 +52,33 @@ changeAssociatedFiles key transform = do
|
||||||
let files' = transform files
|
let files' = transform files
|
||||||
when (files /= files') $
|
when (files /= files') $
|
||||||
liftIO $ viaTmp writeFile mapping $ unlines files'
|
liftIO $ viaTmp writeFile mapping $ unlines files'
|
||||||
return files'
|
top <- fromRepo Git.repoPath
|
||||||
|
return $ map (top </>) files'
|
||||||
|
|
||||||
|
{- Removes an associated file. Returns new associatedFiles value. -}
|
||||||
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
||||||
removeAssociatedFile key file = do
|
removeAssociatedFile key file = do
|
||||||
fs <- changeAssociatedFiles key $ filter (/= normalise file)
|
file' <- normaliseAssociatedFile file
|
||||||
|
fs <- changeAssociatedFiles key $ filter (/= file')
|
||||||
when (null fs) $
|
when (null fs) $
|
||||||
logStatus key InfoMissing
|
logStatus key InfoMissing
|
||||||
return fs
|
return fs
|
||||||
|
|
||||||
|
{- Adds an associated file. Returns new associatedFiles value. -}
|
||||||
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
||||||
addAssociatedFile key file = changeAssociatedFiles key $ \files ->
|
addAssociatedFile key file = do
|
||||||
if file' `elem` files
|
file' <- normaliseAssociatedFile file
|
||||||
then files
|
changeAssociatedFiles key $ \files -> do
|
||||||
else file':files
|
if file' `elem` files
|
||||||
where
|
then files
|
||||||
file' = normalise file
|
else file':files
|
||||||
|
|
||||||
|
{- Associated files are always stored relative to the top of the repository.
|
||||||
|
- The input FilePath is relative to the CWD. -}
|
||||||
|
normaliseAssociatedFile :: FilePath -> Annex FilePath
|
||||||
|
normaliseAssociatedFile file = do
|
||||||
|
top <- fromRepo Git.repoPath
|
||||||
|
liftIO $ relPathDirToFile top <$> absPath file
|
||||||
|
|
||||||
{- Checks if a file in the tree, associated with a key, has not been modified.
|
{- Checks if a file in the tree, associated with a key, has not been modified.
|
||||||
-
|
-
|
||||||
|
|
|
@ -172,7 +172,8 @@ toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
|
||||||
toDirectGen k f = do
|
toDirectGen k f = do
|
||||||
loc <- inRepo $ gitAnnexLocation k
|
loc <- inRepo $ gitAnnexLocation k
|
||||||
createContentDir loc -- thaws directory too
|
createContentDir loc -- thaws directory too
|
||||||
locs <- filter (/= normalise f) <$> addAssociatedFile k f
|
top <- fromRepo Git.repoPath
|
||||||
|
locs <- filter (/= normalise (top </> f)) <$> addAssociatedFile k f
|
||||||
case locs of
|
case locs of
|
||||||
[] -> ifM (liftIO $ doesFileExist loc)
|
[] -> ifM (liftIO $ doesFileExist loc)
|
||||||
( return $ Just $ do
|
( return $ Just $ do
|
||||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -15,6 +15,9 @@ git-annex (3.20130115) UNRELEASED; urgency=low
|
||||||
in the location log data becoming wrong, and fsck being needed to fix it.
|
in the location log data becoming wrong, and fsck being needed to fix it.
|
||||||
* sync: Automatic merge conflict resolution now stages deleted files.
|
* sync: Automatic merge conflict resolution now stages deleted files.
|
||||||
* Depend on git 1.7.7.6 for --no-edit. Closes: #698399
|
* Depend on git 1.7.7.6 for --no-edit. Closes: #698399
|
||||||
|
* Fix direct mode mapping code to always store direct mode filenames
|
||||||
|
relative to the top of the repository, even when operating inside a
|
||||||
|
subdirectory.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Mon, 14 Jan 2013 18:35:01 -0400
|
-- Joey Hess <joeyh@debian.org> Mon, 14 Jan 2013 18:35:01 -0400
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue