summaryrefslogtreecommitdiff
path: root/Command
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 /Command
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.
Diffstat (limited to 'Command')
-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
14 files changed, 59 insertions, 57 deletions
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