added --debugfilter (and annex.debugfilter)

Assistant/WebApp/Configurators/Preferences.hs

@@ -100,8 +100,8 @@ storePrefs p = do
 			then addAutoStartFile here
 			else removeAutoStartFile here
 	setConfig (annexConfig "debug") (boolConfig $ enableDebug p)
-	liftIO $ if enableDebug p
+	if enableDebug p
-		then enableDebugOutput 
+		then enableDebugOutput
 		else disableDebugOutput
 
 getPreferencesR :: Handler Html

CHANGELOG

@@ -3,6 +3,7 @@ git-annex (8.20210331) UNRELEASED; urgency=medium
   * Fix build with persistent-2.12.0.1
   * Avoid excess commits to the git-annex branch when stall detection is
     enabled.
+  * Added --debugfilter (and annex.debugfilter)
 
  -- Joey Hess <id@joeyh.name>  Thu, 01 Apr 2021 12:17:26 -0400
 

CmdLine.hs

@@ -146,7 +146,7 @@ prepRunCommand cmd globalconfig = do
 		Annex.setOutput QuietOutput
 	getParsed globalconfig
 	whenM (annexDebug <$> Annex.getGitConfig) $
-		liftIO enableDebugOutput
+		enableDebugOutput
 
 findAddonCommand :: Maybe String -> IO (Maybe Command)
 findAddonCommand Nothing = return Nothing

CmdLine/Option.hs

@@ -54,6 +54,11 @@ commonGlobalOptions =
 		<> help "don't show debug messages"
 		<> hidden
 		)
+	, globalSetter setdebugfilter $ strOption
+		( long "debugfilter" <> metavar "NAME[,NAME..]"
+		<> help "show debug messages coming from a module"
+		<> hidden
+		)
 	, globalSetter setforcebackend $ strOption
 		( long "backend" <> short 'b' <> metavar paramName
 		<> help "specify key-value backend to use"
@@ -66,6 +71,9 @@ commonGlobalOptions =
 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
 	-- Overriding this way, rather than just setting annexDebug
 	-- makes the config be passed on to any git-annex child processes.
-	setdebug b = Annex.addGitConfigOverride $ decodeBS' $
+	setdebug v = Annex.addGitConfigOverride $
-		debugconfig <> "=" <> boolConfig' b
+		decodeBS' $ debugconfig <> "=" <> boolConfig' v
+	setdebugfilter v = Annex.addGitConfigOverride $ 
+		decodeBS' (debugfilterconfig <> "=") ++ v
 	(ConfigKey debugconfig) = annexConfig "debug"
+	(ConfigKey debugfilterconfig) = annexConfig "debugfilter"

Command/ImportFeed.hs

@@ -102,7 +102,7 @@ getFeed addunlockedmatcher opts cache url = do
 			, "end of feed content"
 			]
 		showEndResult =<< feedProblem url
-			(msg ++ " (use --debug to see the feed content that was downloaded)")
+			(msg ++ " (use --debug --debugfilter=ImportFeed to see the feed content that was downloaded)")
 
 data ToDownload = ToDownload
 	{ feed :: Feed

Messages.hs

@@ -258,13 +258,17 @@ setupConsole = do
 	hSetBuffering stdout LineBuffering
 	hSetBuffering stderr LineBuffering
 
-enableDebugOutput :: IO ()
+enableDebugOutput :: Annex ()
 enableDebugOutput = do
-	dd <- debugDisplayer
+	names <- map encodeBS . annexDebugFilter <$> Annex.getGitConfig
-	configureDebug dd (DebugSelector (\_ -> True))
+	let selector
+		| null names = const True
+		| otherwise = \(DebugSource s) -> any (`S.isInfixOf` s) names
+	dd <- liftIO debugDisplayer
+	liftIO $ configureDebug dd (DebugSelector selector)
 
-disableDebugOutput :: IO ()
+disableDebugOutput :: Annex ()
-disableDebugOutput = do
+disableDebugOutput = liftIO $ do
 	dd <- debugDisplayer
 	configureDebug dd (DebugSelector (\_ -> False))
 

Types/GitConfig.hs

@@ -1,6 +1,6 @@
 {- git-annex configuration
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -90,6 +90,7 @@ data GitConfig = GitConfig
 	, annexSyncContent :: GlobalConfigurable Bool
 	, annexSyncOnlyAnnex :: GlobalConfigurable Bool
 	, annexDebug :: Bool
+	, annexDebugFilter :: [String]
 	, annexWebOptions :: [String]
 	, annexYoutubeDlOptions :: [String]
 	, annexAriaTorrentOptions :: [String]
@@ -170,6 +171,8 @@ extractGitConfig configsource r = GitConfig
 	, annexSyncOnlyAnnex = configurable False $ 
 		getmaybebool (annexConfig "synconlyannex")
 	, annexDebug = getbool (annexConfig "debug") False
+	, annexDebugFilter = maybe [] (splitc ',') $
+		getmaybe (annexConfig "debugfilter")
 	, annexWebOptions = getwords (annexConfig "web-options")
 	, annexYoutubeDlOptions = getwords (annexConfig "youtube-dl-options")
 	, annexAriaTorrentOptions = getwords (annexConfig "aria-torrent-options")

doc/git-annex.mdwn

@@ -780,11 +780,27 @@ may not be explicitly listed on their individual man pages.
 
 * `--debug`
 
-  Show debug messages.
+  Display debug messages.
 
 * `--no-debug`
 
-  Disable debug messages.
+  Disable display of debug messages.
+
+* `--debugfilter=name[,name..]`
+
+  When debug message display has been enabled by `--debug`, this filters
+  the debug messages that are displayed to ones coming from modules with
+  the specified names.
+  
+  To find the names of modules, see the full debug output, which includes
+  the module name, eg "(Utility.Process)"
+
+  The full module name does not need to be
+  specified when using this, a substring of the name will do.
+
+  For example, `--debugfilter=Process,External` will display debugging
+  output when git-annex runs processes, and when it communicates with
+  external special remotes.
 
 * `--numcopies=n`
 
@@ -1214,6 +1230,12 @@ repository, using [[git-annex-config]]. See its man page for a list.)
 
   Set to true to enable debug logging by default.
 
+* `annex.debugfilter`
+
+  Set to configure which debug messages to display (when debug message
+  display has been enabled by annex.debug or --debug). The value is one
+  or more module names, separated by commas.
+
 * `annex.version`
 
   The current version of the git-annex repository. This is

doc/todo/--debug-level___40__and__47__or_-c_annex.debug-level__41___+_more_debug_information_from_git-annex/comment_6_d9014e7e964f47a4fdc680ffc53e17b8._comment

@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2021-04-05T19:28:36Z"
+ content="""
+I've implemented --debugfilter which can select the debug output you want
+to see.
+
+Also started splitting out the immutable parts of AnnexState, but that does
+not yet include debug options, due to the way option parsing currently
+works. Once that gets done, there's a new fastDebug that can be used inside
+tight loop code paths.
+"""]]