{- git-annex checking whether content is wanted - - Copyright 2012-2021 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} module Annex.Wanted where import Annex.Common import Logs.PreferredContent import Annex.UUID import Annex.CatFile import Git.FilePath import qualified Database.Keys import Types.FileMatcher import qualified Data.Set as S {- Check if a file is preferred content for the local repository. -} wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool wantGet d key file = isPreferredContent Nothing S.empty key file d {- Check if a file is preferred content for a repository. -} wantGetBy :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool wantGetBy d key file to = isPreferredContent (Just to) S.empty key file d {- Check if a file is not preferred or required content, and can be - dropped. When a UUID is provided, checks for that repository. - - The AssociatedFile is the one that the user requested to drop. - There may be other files that use the same key, and preferred content - may match some of those and not others. If any are preferred content, - that will prevent dropping. When the other associated files are known, - they can be provided, otherwise this looks them up. -} wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex Bool wantDrop d from key file others = isNothing <$> checkDrop isPreferredContent d from key file others {- Generalization of wantDrop that can also be used with isRequiredContent. - - When the content should not be dropped, returns Just the file that - the checker matches. -} checkDrop :: (Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool) -> Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex (Maybe AssociatedFile) checkDrop checker d from key file others = do u <- maybe getUUID (pure . id) from let s = S.singleton u let checker' f = checker (Just u) s key f d ifM (checker' file) ( return (Just file) , do others' <- case others of Just afs -> pure (filter (/= file) afs) Nothing -> case key of Just k -> mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f)) =<< Database.Keys.getAssociatedFiles k Nothing -> pure [] l <- filterM checker' others' if null l then return Nothing else checkassociated l ) where -- Some associated files that are in the keys database may no -- longer correspond to files in the repository, and should -- not prevent dropping. checkassociated [] = return Nothing checkassociated (af@(AssociatedFile (Just f)):fs) = catKeyFile f >>= \case Just k | Just k == key -> return (Just af) _ -> checkassociated fs checkassociated (AssociatedFile Nothing:fs) = checkassociated fs