much better command action handling for sync --content

This commit is contained in:
Joey Hess 2014-01-20 13:31:03 -04:00
parent cfa6865056
commit 73c420ffcf
5 changed files with 68 additions and 61 deletions

View file

@ -18,6 +18,7 @@ import Annex.Wanted
import Annex.Exception
import Config
import Annex.Content.Direct
import RunCommand
import qualified Data.Set as S
import System.Log.Logger (debugM)
@ -27,29 +28,24 @@ type Reason = String
{- Drop a key from local and/or remote when allowed by the preferred content
- and numcopies settings.
-
- The Remote list can include other remotes that do not have the content.
-
- A remote can be specified that is known to have the key. This can be
- used an an optimisation when eg, a key has just been uploaded to a
- remote.
-}
handleDrops :: Reason -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
handleDrops _ _ _ _ Nothing _ = noop
handleDrops reason rs fromhere key f knownpresentremote = do
locs <- loggedLocations key
handleDropsFrom locs rs reason fromhere key f knownpresentremote
{- The UUIDs are ones where the content is believed to be present.
- The UUIDs are ones where the content is believed to be present.
- The Remote list can include other remotes that do not have the content;
- only ones that match the UUIDs will be dropped from.
- If allowed to drop fromhere, that drop will be tried first.
-
- A remote can be specified that is known to have the key. This can be
- used an an optimisation when eg, a key has just been uploaded to a
- remote.
-
- In direct mode, all associated files are checked, and only if all
- of them are unwanted are they dropped.
-
- The runner is used to run commands, and so can be either callCommand
- or commandAction.
-}
handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
handleDropsFrom _ _ _ _ _ Nothing _ = noop
handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex ()
handleDropsFrom _ _ _ _ _ Nothing _ _ = noop
handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runner = do
fs <- ifM isDirect
( do
l <- associatedFilesRelative key
@ -92,7 +88,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
checkdrop fs n@(have, numcopies, _untrusted) u a =
ifM (allM (wantDrop True u . Just) fs)
( ifM (safely $ callCommand $ a (Just numcopies))
( ifM (safely $ runner $ a (Just numcopies))
( do
liftIO $ debugM "drop" $ unwords
[ "dropped"
@ -113,6 +109,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
Command.Drop.startRemote (Just afile) numcopies key r
slocs = S.fromList locs
safely a = either (const False) id <$> tryAnnex a
slocs = S.fromList locs