summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-02-13 23:42:44 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-02-13 23:52:21 -0400
commitcbaebf538a8659193fb3dbb4f32e0f918a385af3 (patch)
tree63a86b6f3ffe8e08f8610a267c2c19bb2389bfc8 /Command
parentd35a8d85b5ee9ce3d6057300e21729183cce802b (diff)
rework git check-attr interface
Now gitattributes are looked up, efficiently, in only the places that really need them, using the same approach used for cat-file. The old CheckAttr code seemed very fragile, in the way it streamed files through git check-attr. I actually found that cad8824852aa0623dc41eac02a9e2bae47d88ec4 was still deadlocking with ghc 7.4, at the end of adding a lot of files. This should fix that problem, and avoid future ones. The best part is that this removes withAttrFilesInGit and withNumCopies, which were complicated Seek methods, as well as simplfying the types for several other Seek methods that had a Backend tupled in.
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs13
-rw-r--r--Command/AddUrl.hs2
-rw-r--r--Command/Copy.hs6
-rw-r--r--Command/Drop.hs8
-rw-r--r--Command/Fsck.hs7
-rw-r--r--Command/Get.hs8
-rw-r--r--Command/Lock.hs6
-rw-r--r--Command/Migrate.hs8
-rw-r--r--Command/PreCommit.hs11
9 files changed, 34 insertions, 35 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 9410601b8..28971529a 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -16,7 +16,6 @@ import qualified Backend
import Logs.Location
import Annex.Content
import Utility.Touch
-import Backend
def :: [Command]
def = [command "add" paramPaths seek "add files to annex"]
@@ -28,8 +27,8 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
{- The add subcommand annexes a file, storing it in a backend, and then
- moving it into the annex directory and setting up the symlink pointing
- to its content. -}
-start :: BackendFile -> CommandStart
-start p@(_, file) = notBareRepo $ ifAnnexed file fixup add
+start :: FilePath -> CommandStart
+start file = notBareRepo $ ifAnnexed file fixup add
where
add = do
s <- liftIO $ getSymbolicLinkStatus file
@@ -37,7 +36,7 @@ start p@(_, file) = notBareRepo $ ifAnnexed file fixup add
then stop
else do
showStart "add" file
- next $ perform p
+ next $ perform file
fixup (key, _) = do
-- fixup from an interrupted add; the symlink
-- is present but not yet added to git
@@ -45,8 +44,10 @@ start p@(_, file) = notBareRepo $ ifAnnexed file fixup add
liftIO $ removeFile file
next $ next $ cleanup file key =<< inAnnex key
-perform :: BackendFile -> CommandPerform
-perform (backend, file) = Backend.genKey file backend >>= go
+perform :: FilePath -> CommandPerform
+perform file = do
+ backend <- Backend.chooseBackend file
+ Backend.genKey file backend >>= go
where
go Nothing = stop
go (Just (key, _)) = do
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index db73f14e9..f91d6dd55 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -63,7 +63,7 @@ download url file = do
tmp <- fromRepo $ gitAnnexTmpLocation dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
stopUnless (downloadUrl [url] tmp) $ do
- [(backend, _)] <- Backend.chooseBackends [file]
+ backend <- Backend.chooseBackend file
k <- Backend.genKey tmp backend
case k of
Nothing -> stop
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 32b83a526..a8ec22570 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -19,10 +19,10 @@ def = [withOptions Command.Move.options $ command "copy" paramPaths seek
seek :: [CommandSeek]
seek = [withField Command.Move.toOption Remote.byName $ \to ->
withField Command.Move.fromOption Remote.byName $ \from ->
- withNumCopies $ \n -> whenAnnexed $ start to from n]
+ withFilesInGit $ whenAnnexed $ start to from]
-- A copy is just a move that does not delete the source file.
-- However, --auto mode avoids unnecessary copies.
-start :: Maybe Remote -> Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
+start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start to from file (key, backend) = autoCopies file key (<) $ \_numcopies ->
Command.Move.start to from False file (key, backend)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index b40de00cb..9eb36a22f 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -26,11 +26,11 @@ fromOption :: Option
fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
seek :: [CommandSeek]
-seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
- whenAnnexed $ start from n]
+seek = [withField fromOption Remote.byName $ \from ->
+ withFilesInGit $ whenAnnexed $ start from]
-start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
+start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start from file (key, _) = autoCopies file key (>) $ \numcopies -> do
case from of
Nothing -> startLocal file numcopies key
Just remote -> do
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 469fad749..94b360104 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -36,12 +36,13 @@ options = [fromOption]
seek :: [CommandSeek]
seek =
[ withField fromOption Remote.byName $ \from ->
- withNumCopies $ \n -> whenAnnexed $ start from n
+ withFilesInGit $ whenAnnexed $ start from
, withBarePresentKeys startBare
]
-start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start from numcopies file (key, backend) = do
+start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start from file (key, backend) = do
+ numcopies <- numCopies file
showStart "fsck" file
case from of
Nothing -> next $ perform key file backend numcopies
diff --git a/Command/Get.hs b/Command/Get.hs
index 5d032e13c..928ab0f1b 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -19,11 +19,11 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
seek :: [CommandSeek]
seek = [withField Command.Move.fromOption Remote.byName $ \from ->
- withNumCopies $ \n -> whenAnnexed $ start from n]
+ withFilesInGit $ whenAnnexed $ start from]
-start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
- autoCopies key (<) numcopies $ do
+start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start from file (key, _) = stopUnless (not <$> inAnnex key) $
+ autoCopies file key (<) $ \_numcopies -> do
case from of
Nothing -> go $ perform key
Just src -> do
diff --git a/Command/Lock.hs b/Command/Lock.hs
index 329fd3eff..b8aedb252 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -10,7 +10,6 @@ module Command.Lock where
import Common.Annex
import Command
import qualified Annex.Queue
-import Backend
def :: [Command]
def = [command "lock" paramPaths seek "undo unlock command"]
@@ -18,9 +17,8 @@ def = [command "lock" paramPaths seek "undo unlock command"]
seek :: [CommandSeek]
seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
-{- Undo unlock -}
-start :: BackendFile -> CommandStart
-start (_, file) = do
+start :: FilePath -> CommandStart
+start file = do
showStart "lock" file
next $ perform file
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index f6467463d..c6b0f086c 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -19,12 +19,12 @@ def :: [Command]
def = [command "migrate" paramPaths seek "switch data to different backend"]
seek :: [CommandSeek]
-seek = [withBackendFilesInGit $ \(b, f) -> whenAnnexed (start b) f]
+seek = [withFilesInGit $ whenAnnexed start]
-start :: Maybe Backend -> FilePath -> (Key, Backend) -> CommandStart
-start b file (key, oldbackend) = do
+start :: FilePath -> (Key, Backend) -> CommandStart
+start file (key, oldbackend) = do
exists <- inAnnex key
- newbackend <- choosebackend b
+ newbackend <- choosebackend =<< Backend.chooseBackend file
if (newbackend /= oldbackend || upgradableKey key) && exists
then do
showStart "migrate" file
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index 57bc7ac13..b0328ca19 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -10,7 +10,6 @@ module Command.PreCommit where
import Command
import qualified Command.Add
import qualified Command.Fix
-import Backend
def :: [Command]
def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"]
@@ -22,12 +21,12 @@ seek =
[ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
, withFilesUnlockedToBeCommitted start]
-start :: BackendFile -> CommandStart
-start p = next $ perform p
+start :: FilePath -> CommandStart
+start file = next $ perform file
-perform :: BackendFile -> CommandPerform
-perform pair@(_, file) = do
- ok <- doCommand $ Command.Add.start pair
+perform :: FilePath -> CommandPerform
+perform file = do
+ ok <- doCommand $ Command.Add.start file
if ok
then next $ return True
else error $ "failed to add " ++ file ++ "; canceling commit"