better limiting of start actions to only run whenAnnexed

Mostly only refactoring, but this does remove one redundant stat of the
symlink by copy.
This commit is contained in:
Joey Hess 2011-11-10 23:35:08 -04:00
parent 4389782628
commit b327227ba5
16 changed files with 67 additions and 63 deletions

View file

@ -15,8 +15,8 @@ module Command (
stop,
prepCommand,
doCommand,
whenAnnexed,
notAnnexed,
isAnnexed,
notBareRepo,
isBareRepo,
autoCopies
@ -65,12 +65,14 @@ doCommand = start
failure = showEndFail >> return False
status r = showEndResult r >> return r
{- Modifies an action to only act on files that are already annexed,
- and passes the key and backend on to it. -}
whenAnnexed :: (FilePath -> (Key, Backend Annex) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
whenAnnexed a file = maybe (return Nothing) (a file) =<< Backend.lookupFile file
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
whenM isBareRepo $

View file

@ -7,6 +7,7 @@
module Command.Copy where
import Common.Annex
import Command
import qualified Command.Move
@ -16,11 +17,10 @@ def = [dontCheck toOpt $ dontCheck fromOpt $
"copy content of files to/from another repository"]
seek :: [CommandSeek]
seek = [withNumCopies start]
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
-- A copy is just a move that does not delete the source file.
-- However, --auto mode avoids unnecessary copies.
start :: FilePath -> Maybe Int -> CommandStart
start file numcopies = isAnnexed file $ \(key, _) ->
autoCopies key (<) numcopies $
Command.Move.start False file
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
start numcopies file (key, backend) = autoCopies key (<) numcopies $
Command.Move.start False file (key, backend)

View file

@ -22,11 +22,10 @@ def = [dontCheck fromOpt $ command "drop" paramPaths seek
"indicate content of files not currently wanted"]
seek :: [CommandSeek]
seek = [withNumCopies start]
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
start :: FilePath -> Maybe Int -> CommandStart
start file numcopies = isAnnexed file $ \(key, _) ->
autoCopies key (>) numcopies $ do
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
start numcopies file (key, _) = autoCopies key (>) numcopies $ do
from <- Annex.getState Annex.fromremote
case from of
Nothing -> startLocal file numcopies key

View file

@ -16,10 +16,10 @@ def :: [Command]
def = [command "find" paramPaths seek "lists available files"]
seek :: [CommandSeek]
seek = [withFilesInGit start]
seek = [withFilesInGit $ whenAnnexed start]
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
start :: FilePath -> (Key, Backend Annex) -> CommandStart
start file (key, _) = do
-- only files inAnnex are shown, unless the user has requested
-- others via a limit
whenM (liftM2 (||) (inAnnex key) limited) $

View file

@ -17,11 +17,11 @@ def = [command "fix" paramPaths seek
"fix up symlinks to point to annexed content"]
seek :: [CommandSeek]
seek = [withFilesInGit start]
seek = [withFilesInGit $ whenAnnexed start]
{- Fixes the symlink to an annexed file. -}
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
start :: FilePath -> (Key, Backend Annex) -> CommandStart
start file (key, _) = do
link <- calcGitLink file key
l <- liftIO $ readSymbolicLink file
if link == l

View file

@ -25,10 +25,13 @@ def :: [Command]
def = [command "fsck" paramPaths seek "check for problems"]
seek :: [CommandSeek]
seek = [withNumCopies start, withBarePresentKeys startBare]
seek =
[ withNumCopies $ \n -> whenAnnexed $ start n
, withBarePresentKeys startBare
]
start :: FilePath -> Maybe Int -> CommandStart
start file numcopies = isAnnexed file $ \(key, backend) -> do
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
start numcopies file (key, backend) = do
showStart "fsck" file
next $ perform key file backend numcopies

View file

@ -19,10 +19,10 @@ def = [dontCheck fromOpt $ command "get" paramPaths seek
"make content of annexed files available"]
seek :: [CommandSeek]
seek = [withNumCopies start]
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
start :: FilePath -> Maybe Int -> CommandStart
start file numcopies = isAnnexed file $ \(key, _) -> do
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
start numcopies file (key, _) = do
inannex <- inAnnex key
if inannex
then stop

View file

@ -13,17 +13,16 @@ import qualified Backend
import qualified Types.Key
import Annex.Content
import qualified Command.Add
import Backend
import Logs.Web
def :: [Command]
def = [command "migrate" paramPaths seek "switch data to different backend"]
seek :: [CommandSeek]
seek = [withBackendFilesInGit start]
seek = [withBackendFilesInGit $ \(b, f) -> whenAnnexed (start b) f]
start :: BackendFile -> CommandStart
start (b, file) = isAnnexed file $ \(key, oldbackend) -> do
start :: Maybe (Backend Annex) -> FilePath -> (Key, Backend Annex) -> CommandStart
start b file (key, oldbackend) = do
exists <- inAnnex key
newbackend <- choosebackend b
if (newbackend /= oldbackend || upgradableKey key) && exists

View file

@ -21,14 +21,14 @@ def = [dontCheck toOpt $ dontCheck fromOpt $
"move content of files to/from another repository"]
seek :: [CommandSeek]
seek = [withFilesInGit $ start True]
seek = [withFilesInGit $ whenAnnexed $ start True]
{- Move (or copy) a file either --to or --from a repository.
-
- This only operates on the cached file content; it does not involve
- moving data in the key-value backend. -}
start :: Bool -> FilePath -> CommandStart
start move file = isAnnexed file $ \(key, _) -> do
start :: Bool -> FilePath -> (Key, Backend Annex) -> CommandStart
start move file (key, _) = do
noAuto
to <- Annex.getState Annex.toremote
from <- Annex.getState Annex.fromremote

View file

@ -18,8 +18,9 @@ def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"]
{- The pre-commit hook needs to fix symlinks to all files being committed.
- And, it needs to inject unlocked files into the annex. -}
seek :: [CommandSeek]
seek = [withFilesToBeCommitted Command.Fix.start,
withFilesUnlockedToBeCommitted start]
seek =
[ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
, withFilesUnlockedToBeCommitted start]
start :: BackendFile -> CommandStart
start p = next $ perform p

View file

@ -25,19 +25,19 @@ start (src:dest:[])
| src == dest = stop
| otherwise = do
showStart "reinject" dest
next $ perform src dest
next $ whenAnnexed (perform src) dest
start _ = error "specify a src file and a dest file"
perform :: FilePath -> FilePath -> CommandPerform
perform src dest = isAnnexed dest $ \(key, backend) -> do
unlessM (move key) $ error "mv failed!"
perform :: FilePath -> FilePath -> (Key, Backend Annex) -> CommandPerform
perform src _dest (key, backend) = do
unlessM move $ error "mv failed!"
next $ cleanup key backend
where
-- the file might be on a different filesystem,
-- so mv is used rather than simply calling
-- moveToObjectDir; disk space is also
-- checked this way.
move key = getViaTmp key $ \tmp ->
move = getViaTmp key $ \tmp ->
liftIO $ boolSystem "mv" [File src, File tmp]
cleanup :: Key -> Backend Annex -> CommandCleanup

View file

@ -21,11 +21,11 @@ def :: [Command]
def = [command "unannex" paramPaths seek "undo accidential add command"]
seek :: [CommandSeek]
seek = [withFilesInGit start]
seek = [withFilesInGit $ whenAnnexed start]
{- The unannex subcommand undoes an add. -}
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
start :: FilePath -> (Key, Backend Annex) -> CommandStart
start file (key, _) = do
ishere <- inAnnex key
if ishere
then do

View file

@ -33,15 +33,15 @@ check = do
[Params "rev-parse --abbrev-ref HEAD"]
seek :: [CommandSeek]
seek = [withFilesInGit startUnannex, withNothing start]
seek = [withFilesInGit $ whenAnnexed startUnannex, withNothing start]
startUnannex :: FilePath -> CommandStart
startUnannex file = do
startUnannex :: FilePath -> (Key, Backend Annex) -> CommandStart
startUnannex file info = do
-- Force fast mode before running unannex. This way, if multiple
-- files link to a key, it will be left in the annex and hardlinked
-- to by each.
Annex.changeState $ \s -> s { Annex.fast = True }
Command.Unannex.start file
Command.Unannex.start file info
start :: CommandStart
start = next perform

View file

@ -22,12 +22,12 @@ def =
c n = command n paramPaths seek
seek :: [CommandSeek]
seek = [withFilesInGit start]
seek = [withFilesInGit $ whenAnnexed start]
{- The unlock subcommand replaces the symlink with a copy of the file's
- content. -}
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
start :: FilePath -> (Key, Backend Annex) -> CommandStart
start file (key, _) = do
showStart "unlock" file
next $ perform file key

View file

@ -18,10 +18,10 @@ def = [command "whereis" paramPaths seek
"lists repositories that have file content"]
seek :: [CommandSeek]
seek = [withFilesInGit start]
seek = [withFilesInGit $ whenAnnexed start]
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
start :: FilePath -> (Key, Backend Annex) -> CommandStart
start file (key, _) = do
showStart "whereis" file
next $ perform key

View file

@ -33,10 +33,10 @@ withAttrFilesInGit attr a params = do
files <- seekHelper LsFiles.inRepo params
prepFilteredGen a fst $ inRepo $ Git.checkAttr attr files
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
withNumCopies :: (Maybe Int -> FilePath -> CommandStart) -> CommandSeek
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
where
go (file, v) = a file (readMaybe v)
go (file, v) = a (readMaybe v) file
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
withBackendFilesInGit a params = do