Currently it only displays explanations of options like --in and --copies.
In the future, it should explain preferred content expression evaluation
and other decisions.
The explanations of a few things could be better. In particular,
"standard" will just appear as-is (or as "!standard" if it doesn't
match), rather than explaining why the standard preferred content expression
for the group matches or not.
Currently as implemented, it goes to stdout, and so commands like
git-annex find that have custom output will not display --explain
information. Perhaps that should change, dunno.
Sponsored-by: Dartmouth College's DANDI project
, transferrerpool :: TransferrerPool
, debugenabled :: Bool
, debugselector :: DebugSelector
+ , explainenabled :: Bool
, ciphers :: TMVar (M.Map StorableCipher Cipher)
, fast :: Bool
, force :: Bool
, transferrerpool = tp
, debugenabled = annexDebug c
, debugselector = debugSelectorFromGitConfig c
+ , explainenabled = False
, ciphers = cm
, fast = False
, force = False
, SimpleToken "nothing" (simply limitNothing)
, ValueToken "include" (usev limitInclude)
, ValueToken "exclude" (usev limitExclude)
- , ValueToken "largerthan" (usev $ limitSize lb (>))
- , ValueToken "smallerthan" (usev $ limitSize lb (<))
+ , ValueToken "largerthan" (usev $ limitSize lb "largerthan" (>))
+ , ValueToken "smallerthan" (usev $ limitSize lb "smallerthan" (<))
]
commonKeyedTokens :: [ParseToken (MatchFiles Annex)]
-- so the Key is not known.
preferredContentKeylessTokens :: PreferredContentData -> [ParseToken (MatchFiles Annex)]
preferredContentKeylessTokens pcd =
- [ SimpleToken "standard" (call $ matchStandard pcd)
- , SimpleToken "groupwanted" (call $ matchGroupWanted pcd)
- , SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir)
+ [ SimpleToken "standard" (call "standard" $ matchStandard pcd)
+ , SimpleToken "groupwanted" (call "groupwanted" $ matchGroupWanted pcd)
+ , SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir "inpreferreddir")
] ++ commonKeylessTokens LimitAnnexFiles
where
preferreddir = maybe "public" fromProposedAccepted $
[ SimpleToken "present" (simply $ limitPresent $ repoUUID pcd)
, SimpleToken "securehash" (simply limitSecureHash)
, ValueToken "copies" (usev limitCopies)
- , ValueToken "lackingcopies" (usev $ limitLackingCopies False)
- , ValueToken "approxlackingcopies" (usev $ limitLackingCopies True)
+ , ValueToken "lackingcopies" (usev $ limitLackingCopies "lackingcopies" False)
+ , ValueToken "approxlackingcopies" (usev $ limitLackingCopies "approxlackingcopies" True)
, ValueToken "inbackend" (usev limitInBackend)
, ValueToken "metadata" (usev limitMetaData)
, ValueToken "inallgroup" (usev $ limitInAllGroup $ getGroupMap pcd)
usev :: MkLimit Annex -> String -> ParseResult (MatchFiles Annex)
usev a v = Operation <$> a v
-call :: Either String (FileMatcher Annex) -> ParseResult (MatchFiles Annex)
-call (Right sub) = Right $ Operation $ MatchFiles
+call :: String -> Either String (FileMatcher Annex) -> ParseResult (MatchFiles Annex)
+call desc (Right sub) = Right $ Operation $ MatchFiles
{ matchAction = \notpresent mi ->
matchMrun sub $ \o -> matchAction o notpresent mi
, matchNeedsFileName = any matchNeedsFileName sub
, matchNeedsFileContent = any matchNeedsFileContent sub
, matchNeedsKey = any matchNeedsKey sub
, matchNeedsLocationLog = any matchNeedsLocationLog sub
+ , matchDesc = matchDescSimple desc
}
-call (Left err) = Left err
+call _ (Left err) = Left err
git-annex (10.20230627) UNRELEASED; urgency=medium
+ * --explain: New option to display explanations of what git-annex
+ takes into account when deciding what to do.
* satisfy: New command that gets/sends/drops content to satisfy
preferred content settings. This is like to the --content
part of git-annex sync.
<> help "skip files with fewer copies"
<> hidden
)
- , annexOption (setAnnexState . Limit.addLackingCopies False) $ strOption
+ , annexOption (setAnnexState . Limit.addLackingCopies "lackingcopies" False) $ strOption
( long "lackingcopies" <> metavar paramNumber
<> help "match files that need more copies"
<> hidden
)
- , annexOption (setAnnexState . Limit.addLackingCopies True) $ strOption
+ , annexOption (setAnnexState . Limit.addLackingCopies "approxlackingcopies" True) $ strOption
( long "approxlackingcopies" <> metavar paramNumber
<> help "match files that need more copies (faster)"
<> hidden
<> help "show debug messages coming from the specified module"
<> hidden
)
+ , annexFlag (setexplain True)
+ ( long "explain" <> short 'd'
+ <> help "explain why git-annex does what it does"
+ <> hidden
+ )
]
where
setforce v = setAnnexRead $ \rd -> rd { Annex.force = v }
decodeBS (debugfilterconfig <> "=") ++ v
]
+ setexplain v = mconcat
+ [ setAnnexRead $ \rd -> rd { Annex.explainenabled = v }
+ ]
+
(ConfigKey debugconfig) = annexConfig "debug"
(ConfigKey debugfilterconfig) = annexConfig "debugfilter"
case r of
Right (Right ()) -> debug "Database.Handle" "commitDb done"
Right (Left e) -> debug "Database.Handle" ("commitDb failed: " ++ show e)
- Left BlockedIndefinitelyOnMVar -> debug "Database.Handle" ("commitDb BlockedIndefinitelyOnMVar")
+ Left BlockedIndefinitelyOnMVar -> debug "Database.Handle" "commitDb BlockedIndefinitelyOnMVar"
return r
{- user-specified limits on files to act on
-
- - Copyright 2011-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import qualified Utility.RawFilePath as R
import Backend
+import Control.Monad.Writer
import Data.Time.Clock.POSIX
import qualified Data.Set as S
import qualified Data.Map as M
getMatcher :: Annex (MatchInfo -> Annex Bool)
getMatcher = run <$> getMatcher'
where
- run matcher i = Utility.Matcher.matchMrun matcher $ \o ->
- matchAction o S.empty i
+ run matcher i = do
+ (match, desc) <- runWriterT $
+ Utility.Matcher.matchMrun' matcher $ \o ->
+ matchAction o S.empty i
+ explain (getfile i) $ UnquotedString $ unwords
+ [ if match then "matches:" else "does not match:"
+ , Utility.Matcher.describeMatchResult matchDesc desc
+ ]
+ return match
+
+ getfile (MatchingFile f) = Just (matchFile f)
+ getfile (MatchingInfo p) = providedFilePath p
+ getfile (MatchingUserInfo _) = Nothing
getMatcher' :: Annex (Utility.Matcher.Matcher (MatchFiles Annex))
getMatcher' = go =<< Annex.getState Annex.limit
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = "include" =? glob
}
{- Add a limit to skip files that match the glob. -}
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = "exclude" =? glob
}
matchGlobFile :: String -> MatchInfo -> Annex Bool
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = "includesamecontent" =? glob
}
{- Add a limit to skip files when there is no other file using the same
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = "excludesamecontent" =? glob
}
matchSameContentGlob :: String -> MatchInfo -> Annex Bool
-> (UserProvidedInfo -> UserInfo String)
-> Maybe Magic
-> MkLimit Annex
-matchMagic _limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just magic) glob =
+matchMagic limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just magic) glob =
Right $ MatchFiles
{ matchAction = const go
, matchNeedsFileName = False
, matchNeedsFileContent = True
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = limitname =? glob
}
where
cglob = compileGlob glob CaseSensitive (GlobFilePath False) -- memoized
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "unlocked"
}
addLocked :: Annex ()
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "locked"
}
matchLockStatus :: Bool -> MatchInfo -> Annex Bool
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = not inhere
+ , matchDesc = "in" =? s
}
checkinuuid u notpresent key
| null date = do
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = not (isNothing u)
+ , matchDesc = matchDescSimple "present"
}
{- Limit to content that is in a directory, anywhere in the repository tree -}
-limitInDir :: FilePath -> MatchFiles Annex
-limitInDir dir = MatchFiles
+limitInDir :: FilePath -> String -> MatchFiles Annex
+limitInDir dir desc = MatchFiles
{ matchAction = const go
, matchNeedsFileName = True
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple desc
}
where
go (MatchingFile fi) = checkf $ fromRawFilePath $ matchFile fi
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = True
+ , matchDesc = "copies" =? want
}
go' n good notpresent key = do
us <- filter (`S.notMember` notpresent)
| otherwise = (==) <$> readTrustLevel s
{- Adds a limit to match files that need more copies made. -}
-addLackingCopies :: Bool -> String -> Annex ()
-addLackingCopies approx = addLimit . limitLackingCopies approx
+addLackingCopies :: String -> Bool -> String -> Annex ()
+addLackingCopies desc approx = addLimit . limitLackingCopies desc approx
-limitLackingCopies :: Bool -> MkLimit Annex
-limitLackingCopies approx want = case readish want of
+limitLackingCopies :: String -> Bool -> MkLimit Annex
+limitLackingCopies desc approx want = case readish want of
Just needed -> Right $ MatchFiles
{ matchAction = \notpresent mi -> flip checkKey mi $
go mi needed notpresent
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = True
+ , matchDesc = matchDescSimple desc
}
Nothing -> Left "bad value for number of lacking copies"
where
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "unused"
}
where
go _ (MatchingFile _) = return False
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "anything"
}
{- Adds a limit that never matches. -}
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "nothing"
}
{- Adds a limit to skip files not believed to be present in all
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = True
+ , matchDesc = "inallgroup" =? groupname
}
where
check want key = do
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = False
+ , matchDesc = "inbackend" =? name
}
where
check key = pure $ fromKey keyVariety key == variety
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = False
+ , matchDesc = matchDescSimple "securehash"
}
{- Adds a limit to skip files that are too large or too small -}
addLargerThan :: LimitBy -> String -> Annex ()
-addLargerThan lb = addLimit . limitSize lb (>)
+addLargerThan lb = addLimit . limitSize lb "smallerthan" (>)
addSmallerThan :: LimitBy -> String -> Annex ()
-addSmallerThan lb = addLimit . limitSize lb (<)
+addSmallerThan lb = addLimit . limitSize lb "smallerthan" (<)
-limitSize :: LimitBy -> (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex
-limitSize lb vs s = case readSize dataUnits s of
+limitSize :: LimitBy -> String -> (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex
+limitSize lb desc vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ MatchFiles
{ matchAction = go sz
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = desc =? s
}
where
go sz _ (MatchingFile fi) = case lb of
, matchNeedsFileContent = False
, matchNeedsKey = True
, matchNeedsLocationLog = False
+ , matchDesc = "metadata" =? s
}
where
check f matching k = not . S.null
, matchNeedsFileContent = False
, matchNeedsKey = False
, matchNeedsLocationLog = False
+ , matchDesc = "accessedwithin" =? fromDuration duration
}
where
check now k = inAnnexCheck k $ \f ->
checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
checkKey a (MatchingInfo p) = maybe (return False) a (providedKey p)
checkKey a (MatchingUserInfo p) = a =<< getUserInfo (userProvidedKey p)
+
+matchDescSimple :: String -> Bool -> Utility.Matcher.MatchDesc
+matchDescSimple s b = Utility.Matcher.MatchDesc $ (if b then "" else "!") ++ s
+
+(=?) :: String -> String -> (Bool -> Utility.Matcher.MatchDesc)
+k =? v = \b -> Utility.Matcher.MatchDesc $ k ++ (if b then "==" else "!=") ++ v
import qualified Remote
addWantGet :: Annex ()
-addWantGet = addPreferredContentLimit $
+addWantGet = addPreferredContentLimit "want-get" $
checkWant $ wantGet False Nothing
addWantGetBy :: String -> Annex ()
addWantGetBy name = do
u <- Remote.nameToUUID name
- addPreferredContentLimit $ checkWant $ \af ->
+ addPreferredContentLimit "want-get-by" $ checkWant $ \af ->
wantGetBy False Nothing af u
addWantDrop :: Annex ()
-addWantDrop = addPreferredContentLimit $ checkWant $ \af ->
+addWantDrop = addPreferredContentLimit "want-drop" $ checkWant $ \af ->
wantDrop False Nothing Nothing af (Just [])
addWantDropBy :: String -> Annex ()
addWantDropBy name = do
u <- Remote.nameToUUID name
- addPreferredContentLimit $ checkWant $ \af ->
+ addPreferredContentLimit "want-drop-by" $ checkWant $ \af ->
wantDrop False (Just u) Nothing af (Just [])
-addPreferredContentLimit :: (MatchInfo -> Annex Bool) -> Annex ()
-addPreferredContentLimit a = do
+addPreferredContentLimit :: String -> (MatchInfo -> Annex Bool) -> Annex ()
+addPreferredContentLimit desc a = do
nfn <- introspectPreferredRequiredContent matchNeedsFileName Nothing
nfc <- introspectPreferredRequiredContent matchNeedsFileContent Nothing
nk <- introspectPreferredRequiredContent matchNeedsKey Nothing
, matchNeedsFileContent = nfc
, matchNeedsKey = nk
, matchNeedsLocationLog = nl
+ , matchDesc = matchDescSimple desc
}
checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
outputMessage,
withMessageState,
MessageState,
+ explain,
prompt,
mkPrompter,
sanitizeTopLevelExceptionMessages,
JSONOutput _ -> True
_ -> False
+explain :: Maybe RawFilePath -> StringContainingQuotedPath -> Annex ()
+explain Nothing _ = return ()
+explain (Just f) msg = do
+ rd <- Annex.getRead id
+ when (Annex.explainenabled rd) $
+ outputMessage JSON.none id $
+ "[" <> QuotedPath f <> " " <> msg <> "]\n"
+
{- Prevents any concurrent console access while running an action, so
- that the action is the only thing using the console, and can eg prompt
- the user.
{- git-annex file matcher types
-
- - Copyright 2013-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Types.Key (Key)
import Types.Link (LinkType)
import Types.Mime
-import Utility.Matcher (Matcher, Token)
+import Utility.Matcher (Matcher, Token, MatchDesc)
import Utility.FileSize
import Utility.FileSystemEncoding
-- ^ does the matchAction look at information about the key?
, matchNeedsLocationLog :: Bool
-- ^ does the matchAction look at the location log?
+ , matchDesc :: Bool -> MatchDesc
+ -- ^ displayed to the user to describe whether it matched or not
}
type FileMatcher a = Matcher (MatchFiles a)
Token(..),
Matcher(..),
MatchDesc(..),
+ MatchResult(..),
syntaxToken,
generate,
match,
isEmpty,
combineMatchers,
introspect,
- describeMatchDesc,
+ describeMatchResult,
prop_matcher_sane
) where
| MOp op
deriving (Show, Eq, Foldable)
-data MatchDesc op
+newtype MatchDesc = MatchDesc String
+
+data MatchResult op
= MatchedOperation Bool op
| MatchedAnd
| MatchedOr
match a m v = fst $ runWriter $ match' a m v
{- Like match, but accumulates a description of why it did or didn't match. -}
-match' :: (op -> v -> Bool) -> Matcher op -> v -> Writer [MatchDesc op] Bool
+match' :: (op -> v -> Bool) -> Matcher op -> v -> Writer [MatchResult op] Bool
match' a m v = matchMrun' m (\op -> pure (a op v))
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
matchMrun :: Monad m => Matcher op -> (op -> m Bool) -> m Bool
matchMrun m run = fst <$> runWriterT (matchMrun' m run)
-{- Like matchMRun, but accumulates a description of why it did or didn't match. -}
+{- Like matchMrun, but accumulates a description of why it did or didn't match. -}
matchMrun'
- :: (MonadWriter [MatchDesc op] (t m), MonadTrans t, Monad m)
+ :: (MonadWriter [MatchResult op] (t m), MonadTrans t, Monad m)
=> Matcher op
-> (op -> m Bool)
-> t m Bool
introspect :: (a -> Bool) -> Matcher a -> Bool
introspect = any
-{- Converts a [MatchDesc] into a description of what matched and didn't
+{- Converts a [MatchResult] into a description of what matched and didn't
- match. -}
-describeMatchDesc :: (op -> Bool -> String) -> [MatchDesc op] -> String
-describeMatchDesc descop = unwords . go . simplify True
+describeMatchResult :: (op -> Bool -> MatchDesc) -> [MatchResult op] -> String
+describeMatchResult descop = unwords . go . simplify True
where
go [] = []
- go (MatchedOperation b op:rest) = descop op b : go rest
+ go (MatchedOperation b op:rest) =
+ let MatchDesc d = descop op b
+ in d : go rest
go (MatchedAnd:rest) = "and" : go rest
go (MatchedOr:rest) = "or" : go rest
go (MatchedNot:rest) = "not" : go rest
* `--verbose`
- Enable verbose display.
+ Enable verbose display. On by default but can be disabled by --quiet.
+
+* `--explain`
+
+ Display explanations of what git-annex takes into account when deciding
+ what to do. The explanations will be inside square brackets.
+ For example, "[foo is not present here]"
* `--debug`
- Display debug messages.
+ Display debug messages to standard error.
* `--no-debug`
projects / git-annex.git / commitdiff