c3d40b9ec3
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
55 lines
1.8 KiB
Haskell
55 lines
1.8 KiB
Haskell
{- git-annex limits by wanted status
|
|
-
|
|
- Copyright 2012-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Limit.Wanted where
|
|
|
|
import Annex.Common
|
|
import Annex.Wanted
|
|
import Limit
|
|
import Types.FileMatcher
|
|
import Logs.PreferredContent
|
|
import qualified Remote
|
|
|
|
addWantGet :: Annex ()
|
|
addWantGet = addPreferredContentLimit "want-get" $
|
|
checkWant $ wantGet NoLiveUpdate False Nothing
|
|
|
|
addWantGetBy :: String -> Annex ()
|
|
addWantGetBy name = do
|
|
u <- Remote.nameToUUID name
|
|
addPreferredContentLimit "want-get-by" $ checkWant $ \af ->
|
|
wantGetBy NoLiveUpdate False Nothing af u
|
|
|
|
addWantDrop :: Annex ()
|
|
addWantDrop = addPreferredContentLimit "want-drop" $ checkWant $ \af ->
|
|
wantDrop NoLiveUpdate False Nothing Nothing af (Just [])
|
|
|
|
addWantDropBy :: String -> Annex ()
|
|
addWantDropBy name = do
|
|
u <- Remote.nameToUUID name
|
|
addPreferredContentLimit "want-drop-by" $ checkWant $ \af ->
|
|
wantDrop NoLiveUpdate False (Just u) Nothing af (Just [])
|
|
|
|
addPreferredContentLimit :: String -> (MatchInfo -> Annex Bool) -> Annex ()
|
|
addPreferredContentLimit desc a = do
|
|
nfn <- introspectPreferredRequiredContent matchNeedsFileName Nothing
|
|
nfc <- introspectPreferredRequiredContent matchNeedsFileContent Nothing
|
|
nk <- introspectPreferredRequiredContent matchNeedsKey Nothing
|
|
nl <- introspectPreferredRequiredContent matchNeedsLocationLog Nothing
|
|
addLimit $ Right $ MatchFiles
|
|
{ matchAction = const $ const a
|
|
, matchNeedsFileName = nfn
|
|
, matchNeedsFileContent = nfc
|
|
, matchNeedsKey = nk
|
|
, matchNeedsLocationLog = nl
|
|
, matchDesc = matchDescSimple desc
|
|
}
|
|
|
|
checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
|
|
checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi))
|
|
checkWant a (MatchingInfo p) = a (AssociatedFile (providedFilePath p))
|
|
checkWant _ (MatchingUserInfo {}) = return False
|