aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-10 23:35:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-10 23:45:14 -0400
commitb327227ba596d4fc5012138d03390c3eb861b808 (patch)
tree921c3ca6851d1ede45c387d9fd54997dcbf44906
parent4389782628a1cc683ef238e848b6311fc4bd82c3 (diff)
better limiting of start actions to only run whenAnnexed
Mostly only refactoring, but this does remove one redundant stat of the symlink by copy.
-rw-r--r--Command.hs10
-rw-r--r--Command/Copy.hs10
-rw-r--r--Command/Drop.hs25
-rw-r--r--Command/Find.hs6
-rw-r--r--Command/Fix.hs6
-rw-r--r--Command/Fsck.hs9
-rw-r--r--Command/Get.hs6
-rw-r--r--Command/Migrate.hs7
-rw-r--r--Command/Move.hs6
-rw-r--r--Command/PreCommit.hs5
-rw-r--r--Command/Reinject.hs10
-rw-r--r--Command/Unannex.hs6
-rw-r--r--Command/Uninit.hs8
-rw-r--r--Command/Unlock.hs6
-rw-r--r--Command/Whereis.hs6
-rw-r--r--Seek.hs4
16 files changed, 67 insertions, 63 deletions
diff --git a/Command.hs b/Command.hs
index c436c5b62..083be37f2 100644
--- a/Command.hs
+++ b/Command.hs
@@ -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 $
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 8316b7cab..16de423ac 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -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)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 44685ffcd..ee3583869 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -22,20 +22,19 @@ 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
- from <- Annex.getState Annex.fromremote
- case from of
- Nothing -> startLocal file numcopies key
- Just name -> do
- remote <- Remote.byName name
- u <- getUUID
- if Remote.uuid remote == u
- then startLocal file numcopies key
- else startRemote file numcopies key remote
+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
+ Just name -> do
+ remote <- Remote.byName name
+ u <- getUUID
+ if Remote.uuid remote == u
+ then startLocal file numcopies key
+ else startRemote file numcopies key remote
startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
startLocal file numcopies key = do
diff --git a/Command/Find.hs b/Command/Find.hs
index 46364c987..c816ff071 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -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) $
diff --git a/Command/Fix.hs b/Command/Fix.hs
index b46d6e8ec..27c4b167e 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -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
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 89485b778..bdc509941 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -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
diff --git a/Command/Get.hs b/Command/Get.hs
index 4a0908bdc..f7d953bb6 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -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
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index a823466dc..3c87f4136 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -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
diff --git a/Command/Move.hs b/Command/Move.hs
index ffa246ab6..9553d1639 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -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
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index 1949de113..57bc7ac13 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -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
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 1277edf90..cfa0655ef 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -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
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index d24f921a9..b9190ce04 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -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
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index f317b7620..8987240be 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -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
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 590b75311..22f9ce710 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -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
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 0681bfba1..eb2ae3d4e 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -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
diff --git a/Seek.hs b/Seek.hs
index 3c83ebc35..9863b33c4 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -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