829ae91009
WorkTree.lookupFile was finding a key for a file that's deleted from the work tree, which is different than the v5 behavior (though perhaps the same as the direct mode behavior). Fix by checking that the work tree file exists before catting its key. Hopefully this won't slow down much, probably the catKey is much more expensive. I can't see any way to optimise this, except perhaps to make Command.Unused check if work tree files exist before/after calling lookupFile. But, it seems better to make lookupFile really only find keys for worktree files; that's what it's intended to do.
43 lines
1.2 KiB
Haskell
43 lines
1.2 KiB
Haskell
{- git-annex worktree files
|
|
-
|
|
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.WorkTree where
|
|
|
|
import Common.Annex
|
|
import Annex.Link
|
|
import Annex.CatFile
|
|
import Annex.Version
|
|
import Config
|
|
|
|
{- Looks up the key corresponding to an annexed file in the work tree,
|
|
- by examining what the file links to.
|
|
-
|
|
- An unlocked file will not have a link on disk, so fall back to
|
|
- looking for a pointer to a key in git.
|
|
-}
|
|
lookupFile :: FilePath -> Annex (Maybe Key)
|
|
lookupFile file = do
|
|
mkey <- isAnnexLink file
|
|
case mkey of
|
|
Just key -> makeret key
|
|
Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect)
|
|
( ifM (liftIO $ doesFileExist file)
|
|
( maybe (return Nothing) makeret =<< catKeyFile file
|
|
, return Nothing
|
|
)
|
|
, return Nothing
|
|
)
|
|
where
|
|
makeret = return . Just
|
|
|
|
{- Modifies an action to only act on files that are already annexed,
|
|
- and passes the key on to it. -}
|
|
whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
|
|
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
|
|
|
|
ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
|
|
ifAnnexed file yes no = maybe no yes =<< lookupFile file
|