add Key to all ActionItem constructors
This commit is contained in:
parent
3893d84764
commit
258a7c5cd1
15 changed files with 70 additions and 52 deletions
|
@ -63,9 +63,10 @@ seek o = allowConcurrentOutput $
|
|||
go = whenAnnexed $ start o
|
||||
|
||||
start :: DropOptions -> FilePath -> Key -> CommandStart
|
||||
start o file key = start' o key afile (mkActionItem afile)
|
||||
start o file key = start' o key afile ai
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
ai = mkActionItem (key, afile)
|
||||
|
||||
start' :: DropOptions -> Key -> AssociatedFile -> ActionItem -> CommandStart
|
||||
start' o key afile ai = onlyActionOn key $ do
|
||||
|
|
|
@ -73,7 +73,7 @@ start o file key = ifM (limited <||> inAnnex key)
|
|||
)
|
||||
|
||||
startKeys :: FindOptions -> (Key, ActionItem) -> CommandStart
|
||||
startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf)) =
|
||||
startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
|
||||
start o (getTopFilePath topf) key
|
||||
startKeys _ _ = stop
|
||||
|
||||
|
|
|
@ -114,7 +114,7 @@ start from inc file key = Backend.getBackend file key >>= \case
|
|||
Nothing -> go $ perform key file backend numcopies
|
||||
Just r -> go $ performRemote key afile backend numcopies r
|
||||
where
|
||||
go = runFsck inc (mkActionItem afile) key
|
||||
go = runFsck inc (mkActionItem (key, afile)) key
|
||||
afile = AssociatedFile (Just file)
|
||||
|
||||
perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
|
||||
|
@ -134,7 +134,7 @@ perform key file backend numcopies = do
|
|||
]
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
ai = ActionItemAssociatedFile afile
|
||||
ai = mkActionItem (key, afile)
|
||||
|
||||
{- To fsck a remote, the content is retrieved to a tmp file,
|
||||
- and checked locally. -}
|
||||
|
@ -161,7 +161,7 @@ performRemote key afile backend numcopies remote =
|
|||
, withLocalCopy localcopy $ checkBackendRemote backend key remote ai
|
||||
, checkKeyNumCopies key afile numcopies
|
||||
]
|
||||
ai = ActionItemAssociatedFile afile
|
||||
ai = mkActionItem (key, afile)
|
||||
withtmp a = do
|
||||
pid <- liftIO getPID
|
||||
t <- fromRepo gitAnnexTmpObjectDir
|
||||
|
@ -275,7 +275,7 @@ verifyLocationLog' key ai present u updatestatus = do
|
|||
fix InfoMissing
|
||||
warning $
|
||||
"** Based on the location log, " ++
|
||||
actionItemDesc ai key ++
|
||||
actionItemDesc ai ++
|
||||
"\n** was expected to be present, " ++
|
||||
"but its content is missing."
|
||||
return False
|
||||
|
@ -295,7 +295,7 @@ verifyLocationLog' key ai present u updatestatus = do
|
|||
{- Verifies that all repos that are required to contain the content do,
|
||||
- checking against the location log. -}
|
||||
verifyRequiredContent :: Key -> ActionItem -> Annex Bool
|
||||
verifyRequiredContent key ai@(ActionItemAssociatedFile afile) = do
|
||||
verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = do
|
||||
requiredlocs <- S.fromList . M.keys <$> requiredContentMap
|
||||
if S.null requiredlocs
|
||||
then return True
|
||||
|
@ -310,7 +310,7 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile) = do
|
|||
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
|
||||
warning $
|
||||
"** Required content " ++
|
||||
actionItemDesc ai key ++
|
||||
actionItemDesc ai ++
|
||||
" is missing from these repositories:\n" ++
|
||||
missingrequired
|
||||
return False
|
||||
|
@ -401,7 +401,7 @@ checkKeySizeOr bad key file ai = case keySize key of
|
|||
badsize a b = do
|
||||
msg <- bad key
|
||||
warning $ concat
|
||||
[ actionItemDesc ai key
|
||||
[ actionItemDesc ai
|
||||
, ": Bad file size ("
|
||||
, compareSizes storageUnits True a b
|
||||
, "); "
|
||||
|
@ -419,7 +419,7 @@ checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
|
|||
case Types.Backend.canUpgradeKey backend of
|
||||
Just a | a key -> do
|
||||
warning $ concat
|
||||
[ actionItemDesc ai key
|
||||
[ actionItemDesc ai
|
||||
, ": Can be upgraded to an improved key format. "
|
||||
, "You can do so by running: git annex migrate --backend="
|
||||
, decodeBS (formatKeyVariety (keyVariety key)) ++ " "
|
||||
|
@ -451,18 +451,20 @@ checkBackend backend key keystatus afile = go =<< isDirect
|
|||
content <- calcRepo $ gitAnnexLocation key
|
||||
ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content))
|
||||
( nocheck
|
||||
, checkBackendOr badContent backend key content (mkActionItem afile)
|
||||
, checkBackendOr badContent backend key content ai
|
||||
)
|
||||
go True = case afile of
|
||||
AssociatedFile Nothing -> nocheck
|
||||
AssociatedFile (Just f) -> checkdirect f
|
||||
checkdirect file = ifM (Direct.goodContent key file)
|
||||
( checkBackendOr' (badContentDirect file) backend key file (mkActionItem afile)
|
||||
( checkBackendOr' (badContentDirect file) backend key file ai
|
||||
(Direct.goodContent key file)
|
||||
, nocheck
|
||||
)
|
||||
nocheck = return True
|
||||
|
||||
ai = mkActionItem (key, afile)
|
||||
|
||||
checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool
|
||||
checkBackendRemote backend key remote ai localcopy =
|
||||
checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai
|
||||
|
@ -485,7 +487,7 @@ checkBackendOr' bad backend key file ai postcheck =
|
|||
unless ok $ do
|
||||
msg <- bad key
|
||||
warning $ concat
|
||||
[ actionItemDesc ai key
|
||||
[ actionItemDesc ai
|
||||
, ": Bad file content; "
|
||||
, msg
|
||||
]
|
||||
|
|
|
@ -49,9 +49,10 @@ seek o = allowConcurrentOutput $ do
|
|||
=<< workTreeItems (getFiles o)
|
||||
|
||||
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
|
||||
start o from file key = start' expensivecheck from key afile (mkActionItem afile)
|
||||
start o from file key = start' expensivecheck from key afile ai
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
ai = mkActionItem (key, afile)
|
||||
expensivecheck
|
||||
| autoMode o = numCopiesCheck file key (<)
|
||||
<||> wantGet False (Just key) afile
|
||||
|
|
|
@ -445,9 +445,8 @@ transfer_list = stat desc $ nojson $ lift $ do
|
|||
desc = "transfers in progress"
|
||||
line uuidmap t i = unwords
|
||||
[ formatDirection (transferDirection t) ++ "ing"
|
||||
, actionItemDesc
|
||||
(ActionItemAssociatedFile (associatedFile i))
|
||||
(transferKey t)
|
||||
, actionItemDesc $ mkActionItem
|
||||
(transferKey t, associatedFile i)
|
||||
, if transferDirection t == Upload then "to" else "from"
|
||||
, maybe (fromUUID $ transferUUID t) Remote.name $
|
||||
M.lookup (transferUUID t) uuidmap
|
||||
|
|
|
@ -93,7 +93,7 @@ seek o = case batchOption o of
|
|||
_ -> giveup "--batch is currently only supported in --json mode"
|
||||
|
||||
start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart
|
||||
start c o file k = startKeys c o (k, mkActionItem afile)
|
||||
start c o file k = startKeys c o (k, mkActionItem (k, afile))
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
|
||||
|
@ -164,7 +164,7 @@ startBatch (i, (MetaData m)) = case i of
|
|||
Left f -> do
|
||||
mk <- lookupFile f
|
||||
case mk of
|
||||
Just k -> go k (mkActionItem (AssociatedFile (Just f)))
|
||||
Just k -> go k (mkActionItem (k, AssociatedFile (Just f)))
|
||||
Nothing -> giveup $ "not an annexed file: " ++ f
|
||||
Right k -> go k (mkActionItem k)
|
||||
where
|
||||
|
|
|
@ -48,9 +48,10 @@ seek o = allowConcurrentOutput $
|
|||
=<< workTreeItems (mirrorFiles o)
|
||||
|
||||
start :: MirrorOptions -> FilePath -> Key -> CommandStart
|
||||
start o file k = startKey o afile (k, mkActionItem afile)
|
||||
start o file k = startKey o afile (k, ai)
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
ai = mkActionItem (k, afile)
|
||||
|
||||
startKey :: MirrorOptions -> AssociatedFile -> (Key, ActionItem) -> CommandStart
|
||||
startKey o afile (key, ai) = onlyActionOn key $ case fromToOptions o of
|
||||
|
|
|
@ -64,10 +64,10 @@ seek o = allowConcurrentOutput $ do
|
|||
=<< workTreeItems (moveFiles o)
|
||||
|
||||
start :: FromToHereOptions -> RemoveWhen -> FilePath -> Key -> CommandStart
|
||||
start fromto removewhen f k =
|
||||
start' fromto removewhen afile k (mkActionItem afile)
|
||||
start fromto removewhen f k = start' fromto removewhen afile k ai
|
||||
where
|
||||
afile = AssociatedFile (Just f)
|
||||
ai = mkActionItem (k, afile)
|
||||
|
||||
startKey :: FromToHereOptions -> RemoveWhen -> (Key, ActionItem) -> CommandStart
|
||||
startKey fromto removewhen =
|
||||
|
|
|
@ -690,7 +690,7 @@ syncFile ebloom rs af k = onlyActionOn' k $ do
|
|||
, return []
|
||||
)
|
||||
get have = includeCommandAction $ do
|
||||
showStartKey "get" k (mkActionItem af)
|
||||
showStartKey "get" k ai
|
||||
next $ next $ getKey' k af have
|
||||
|
||||
wantput r
|
||||
|
@ -705,7 +705,9 @@ syncFile ebloom rs af k = onlyActionOn' k $ do
|
|||
, return []
|
||||
)
|
||||
put dest = includeCommandAction $
|
||||
Command.Move.toStart' dest Command.Move.RemoveNever af k (mkActionItem af)
|
||||
Command.Move.toStart' dest Command.Move.RemoveNever af k ai
|
||||
|
||||
ai = mkActionItem (k, af)
|
||||
|
||||
{- When a remote has an annex-tracking-branch configuration, change the export
|
||||
- to contain the current content of the branch. Otherwise, transfer any files
|
||||
|
|
|
@ -48,7 +48,7 @@ seek o = do
|
|||
=<< workTreeItems (whereisFiles o)
|
||||
|
||||
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
|
||||
start remotemap file key = startKeys remotemap (key, mkActionItem afile)
|
||||
start remotemap file key = startKeys remotemap (key, mkActionItem (key, afile))
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue