git-annex/Limit/Wanted.hs
Joey Hess 8b74f01a26
split ProvidedInfo and UserProvidedInfo
The latter is for git-annex matchexpression and matching against it can
throw an exception. Splitting out the former reduces the potential for
mistakes and avoids needing to worry about matching against that
throwing an exception.

This is more groundwork for matching largefiles while importing,
without downloading content.

This commit was sponsored by Graham Spencer on Patreon.
2020-09-28 12:12:38 -04:00

42 lines
1.3 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
addWantGet :: Annex ()
addWantGet = addPreferredContentLimit $
checkWant $ wantGet False Nothing
addWantDrop :: Annex ()
addWantDrop = addPreferredContentLimit $
checkWant $ wantDrop False Nothing Nothing
addPreferredContentLimit :: (MatchInfo -> Annex Bool) -> Annex ()
addPreferredContentLimit a = do
nfn <- introspectPreferredRequiredContent matchNeedsFileName Nothing
nfc <- introspectPreferredRequiredContent matchNeedsFileContent Nothing
nk <- introspectPreferredRequiredContent matchNeedsKey Nothing
nl <- introspectPreferredRequiredContent matchNeedsLocationLog Nothing
addLimit $ Right $ MatchFiles
{ matchAction = const a
, matchNeedsFileName = nfn
, matchNeedsFileContent = nfc
, matchNeedsKey = nk
, matchNeedsLocationLog = nl
}
checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi))
checkWant a (MatchingKey _ af) = a af
checkWant a (MatchingInfo p) = a (AssociatedFile (Just $ providedFilePath p))
checkWant _ (MatchingUserInfo {}) = return False