implement fastDebug

Most of the changes here involve global option parsing: GlobalSetter
changed so it can both run an Annex action to set state, but can also
change the AnnexRead value, which is immutable once the Annex monad is
running.

That allowed a debugselector value to be added to AnnexRead, seeded
from the git config. The --debugfilter option's GlobalSetter then updates
the AnnexRead.

This improved GlobalSetter can later be used to move more stuff to
AnnexRead. Things that don't involve a git config will be easier to
move, and probably a *lot* of things can be moved eventually.

fastDebug, while implemented, is not used anywhere yet. But it should be
fast..

Annex.hs

@@ -76,6 +76,7 @@ import Types.RemoteConfig
 import Types.TransferrerPool
 import Types.VectorClock
 import Annex.VectorClock.Utility
+import Annex.Debug.Utility
 import qualified Database.Keys.Handle as Keys
 import Utility.InodeCache
 import Utility.Url
@@ -119,10 +120,11 @@ data AnnexRead = AnnexRead
 	, sshstalecleaned :: TMVar Bool
 	, signalactions :: TVar (M.Map SignalAction (Int -> IO ()))
 	, transferrerpool :: TransferrerPool
+	, debugselector :: DebugSelector
 	}
 
-newAnnexRead :: IO AnnexRead
+newAnnexRead :: GitConfig -> IO AnnexRead
-newAnnexRead = do
+newAnnexRead c = do
 	emptyactivekeys <- newTVarIO M.empty
 	emptyactiveremotes <- newMVar M.empty
 	kh <- Keys.newDbHandle
@@ -136,6 +138,7 @@ newAnnexRead = do
 		, sshstalecleaned = sc
 		, signalactions = si
 		, transferrerpool = tp
+		, debugselector = debugSelectorFromGitConfig c
 		}
 
 -- Values that can change while running an Annex action.
@@ -261,7 +264,7 @@ new r = do
 	r' <- Git.Config.read r
 	let c = extractGitConfig FromGitConfig r'
 	st <- newAnnexState c =<< fixupRepo r' c
-	rd <- newAnnexRead
+	rd <- newAnnexRead c
 	return (st, rd)
 
 {- Performs an action in the Annex monad from a starting state,

Annex/Debug.hs

@@ -0,0 +1,30 @@
+{- git-annex debugging
+ -
+ - Copyright 2021 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Debug (
+	DebugSelector(..),
+	DebugSource(..),
+	debug,
+	fastDebug,
+	configureDebug,
+	debugSelectorFromGitConfig,
+	parseDebugSelector,
+) where
+
+import Common
+import qualified Annex
+import Utility.Debug hiding (fastDebug)
+import qualified Utility.Debug
+import Annex.Debug.Utility
+
+-- | This is faster than using debug, because the DebugSelector
+-- is read from the Annex monad, which avoids any IORef access overhead
+-- when debugging is not enabled.
+fastDebug :: DebugSource -> String -> Annex.Annex ()
+fastDebug src msg = do
+	selector <- Annex.getRead Annex.debugselector
+	liftIO $ Utility.Debug.fastDebug selector src msg

Annex/Debug/Utility.hs

@@ -0,0 +1,32 @@
+{- git-annex debugging, utility functions
+ -
+ - Copyright 2021 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Debug.Utility (
+	debugSelectorFromGitConfig,
+	parseDebugSelector,
+	DebugSelector,
+) where
+
+import Types.GitConfig
+import Utility.Debug
+import Utility.Split
+import Utility.FileSystemEncoding
+
+import qualified Data.ByteString as S
+
+debugSelectorFromGitConfig :: GitConfig -> DebugSelector
+debugSelectorFromGitConfig = 
+	maybe NoDebugSelector parseDebugSelector . annexDebugFilter
+
+parseDebugSelector :: String -> DebugSelector
+parseDebugSelector = DebugSelector . matchDebugSource . splitSelectorNames
+
+splitSelectorNames :: String -> [S.ByteString]
+splitSelectorNames = map encodeBS . splitc ','
+
+matchDebugSource :: [S.ByteString] -> DebugSource -> Bool
+matchDebugSource names (DebugSource s) = any (`S.isInfixOf` s) names

CmdLine.hs

@@ -53,14 +53,14 @@ dispatch' subcommandname args fuzzy cmds allargs allcmds fields getgitrepo progn
   where
 	go (Right g) = do
 		g' <- Git.Config.read g
-		(cmd, seek, globalconfig) <- parsewith False cmdparser
+		(cmd, seek, globalsetter) <- parsewith False cmdparser
 			(\a -> a (Just g'))
 			O.handleParseResult
-		state <- Annex.new g'
+		state <- applyAnnexReadSetter globalsetter <$> Annex.new g'
 		Annex.eval state $ do
 			checkEnvironment
 			forM_ fields $ uncurry Annex.setField
-			prepRunCommand cmd globalconfig
+			prepRunCommand cmd globalsetter
 			startup
 			performCommandAction cmd seek $
 				shutdown $ cmdnocommit cmd
@@ -141,11 +141,14 @@ subCmdName argv = (name, args)
 		| "-" `isPrefixOf` a = findname as (a:c)
 		| otherwise = (Just a, reverse c ++ as)
 
+-- | Note that the GlobalSetter must have already had its annexReadSetter
+-- applied before entering the Annex monad; that cannot be changed while
+-- running in the Annex monad.
 prepRunCommand :: Command -> GlobalSetter -> Annex ()
-prepRunCommand cmd globalconfig = do
+prepRunCommand cmd globalsetter = do
 	when (cmdnomessages cmd) $
 		Annex.setOutput QuietOutput
-	getParsed globalconfig
+	annexStateSetter globalsetter
 	whenM (annexDebug <$> Annex.getGitConfig) $
 		enableDebugOutput
 

CmdLine/GitAnnex/Options.hs

@@ -43,55 +43,55 @@ import Annex.Concurrent
 -- although not always used.
 gitAnnexGlobalOptions :: [GlobalOption]
 gitAnnexGlobalOptions = commonGlobalOptions ++
-	[ globalSetter setnumcopies $ option auto
+	[ globalOption (setAnnexState . setnumcopies) $ option auto
 		( long "numcopies" <> short 'N' <> metavar paramNumber
 		<> help "override desired number of copies"
 		<> hidden
 		)
-	, globalSetter setmincopies $ option auto
+	, globalOption (setAnnexState . setmincopies) $ option auto
 		( long "mincopies" <> short 'N' <> metavar paramNumber
 		<> help "override minimum number of copies"
 		<> hidden
 		)
-	, globalSetter (Remote.forceTrust Trusted) $ strOption
+	, globalOption (setAnnexState . Remote.forceTrust Trusted) $ strOption
 		( long "trust" <> metavar paramRemote
 		<> help "deprecated, does not override trust setting"
 		<> hidden
 		<> completeRemotes
 		)
-	, globalSetter (Remote.forceTrust SemiTrusted) $ strOption
+	, globalOption (setAnnexState . Remote.forceTrust SemiTrusted) $ strOption
 		( long "semitrust" <> metavar paramRemote
 		<> help "override trust setting back to default"
 		<> hidden
 		<> completeRemotes
 		)
-	, globalSetter (Remote.forceTrust UnTrusted) $ strOption
+	, globalOption (setAnnexState . Remote.forceTrust UnTrusted) $ strOption
 		( long "untrust" <> metavar paramRemote
 		<> help "override trust setting to untrusted"
 		<> hidden
 		<> completeRemotes
 		)
-	, globalSetter setgitconfig $ strOption
+	, globalOption (setAnnexState . setgitconfig) $ strOption
 		( long "config" <> short 'c' <> metavar "NAME=VALUE"
 		<> help "override git configuration setting"
 		<> hidden
 		)
-	, globalSetter setuseragent $ strOption
+	, globalOption (setAnnexState . setuseragent) $ strOption
 		( long "user-agent" <> metavar paramName
 		<> help "override default User-Agent"
 		<> hidden
 		)
-	, globalFlag (toplevelWarning False "--trust-glacier no longer has any effect")
+	, globalFlag (setAnnexState $ toplevelWarning False "--trust-glacier no longer has any effect")
 		( long "trust-glacier"
 		<> help "deprecated, does not trust Amazon Glacier inventory"
 		<> hidden
 		)
-	, globalFlag (setdesktopnotify mkNotifyFinish)
+	, globalFlag (setAnnexState $ setdesktopnotify mkNotifyFinish)
 		( long "notify-finish"
 		<> help "show desktop notification after transfer finishes"
 		<> hidden
 		)
-	, globalFlag (setdesktopnotify mkNotifyStart)
+	, globalFlag (setAnnexState $ setdesktopnotify mkNotifyStart)
 		( long "notify-start"
 		<> help "show desktop notification after transfer starts"
 		<> hidden
@@ -241,80 +241,81 @@ keyMatchingOptions = keyMatchingOptions' ++ combiningOptions ++ timeLimitOption
 
 keyMatchingOptions' :: [GlobalOption]
 keyMatchingOptions' = 
-	[ globalSetter Limit.addIn $ strOption
+	[ globalOption (setAnnexState . Limit.addIn) $ strOption
 		( long "in" <> short 'i' <> metavar paramRemote
 		<> help "match files present in a remote"
 		<> hidden
 		<> completeRemotes
 		)
-	, globalSetter Limit.addCopies $ strOption
+	, globalOption (setAnnexState . Limit.addCopies) $ strOption
 		( long "copies" <> short 'C' <> metavar paramRemote
 		<> help "skip files with fewer copies"
 		<> hidden
 		)
-	, globalSetter (Limit.addLackingCopies False) $ strOption
+	, globalOption (setAnnexState . Limit.addLackingCopies False) $ strOption
 		( long "lackingcopies" <> metavar paramNumber
 		<> help "match files that need more copies"
 		<> hidden
 		)
-	, globalSetter (Limit.addLackingCopies True) $ strOption
+	, globalOption (setAnnexState . Limit.addLackingCopies True) $ strOption
 		( long "approxlackingcopies" <> metavar paramNumber
 		<> help "match files that need more copies (faster)"
 		<> hidden
 		)
-	, globalSetter Limit.addInBackend $ strOption
+	, globalOption (setAnnexState . Limit.addInBackend) $ strOption
 		( long "inbackend" <> short 'B' <> metavar paramName
 		<> help "match files using a key-value backend"
 		<> hidden
 		<> completeBackends
 		)
-	, globalFlag Limit.addSecureHash
+	, globalFlag (setAnnexState Limit.addSecureHash)
 		( long "securehash"
 		<> help "match files using a cryptographically secure hash"
 		<> hidden
 		)
-	, globalSetter Limit.addInAllGroup $ strOption
+	, globalOption (setAnnexState . Limit.addInAllGroup) $ strOption
 		( long "inallgroup" <> metavar paramGroup
 		<> help "match files present in all remotes in a group"
 		<> hidden
 		)
-	, globalSetter Limit.addMetaData $ strOption
+	, globalOption (setAnnexState . Limit.addMetaData) $ strOption
 		( long "metadata" <> metavar "FIELD=VALUE"
 		<> help "match files with attached metadata"
 		<> hidden
 		)
-	, globalFlag Limit.Wanted.addWantGet
+	, globalFlag (setAnnexState Limit.Wanted.addWantGet)
 		( long "want-get"
 		<> help "match files the repository wants to get"
 		<> hidden
 		)
-	, globalFlag Limit.Wanted.addWantDrop
+	, globalFlag (setAnnexState Limit.Wanted.addWantDrop)
 		( long "want-drop"
 		<> help "match files the repository wants to drop"
 		<> hidden
 		)
-	, globalSetter Limit.addAccessedWithin $ option (eitherReader parseDuration)
+	, globalOption (setAnnexState . Limit.addAccessedWithin) $
-		( long "accessedwithin"
+		option (eitherReader parseDuration)
-		<> metavar paramTime
+			( long "accessedwithin"
-		<> help "match files accessed within a time interval"
+			<> metavar paramTime
-		<> hidden
+			<> help "match files accessed within a time interval"
-		)
+			<> hidden
-	, globalSetter Limit.addMimeType $ strOption
+			)
+	, globalOption (setAnnexState . Limit.addMimeType) $ strOption
 		( long "mimetype" <> metavar paramGlob
 		<> help "match files by mime type"
 		<> hidden
 		)
-	, globalSetter Limit.addMimeEncoding $ strOption
+	, globalOption (setAnnexState . Limit.addMimeEncoding) $ strOption
 		( long "mimeencoding" <> metavar paramGlob
 		<> help "match files by mime encoding"
 		<> hidden
 		)
-	, globalFlag Limit.addUnlocked
+	, globalFlag (setAnnexState Limit.addUnlocked)
 		( long "unlocked"
 		<> help "match files that are unlocked"
 		<> hidden
 		)
-	, globalFlag Limit.addLocked
+	, globalFlag (setAnnexState Limit.addLocked)
 		( long "locked"
 		<> help "match files that are locked"
 		<> hidden
@@ -327,22 +328,22 @@ fileMatchingOptions lb = fileMatchingOptions' lb ++ combiningOptions ++ timeLimi
 
 fileMatchingOptions' :: Limit.LimitBy -> [GlobalOption]
 fileMatchingOptions' lb =
-	[ globalSetter Limit.addExclude $ strOption
+	[ globalOption (setAnnexState . Limit.addExclude) $ strOption
 		( long "exclude" <> short 'x' <> metavar paramGlob
 		<> help "skip files matching the glob pattern"
 		<> hidden
 		)
-	, globalSetter Limit.addInclude $ strOption
+	, globalOption (setAnnexState . Limit.addInclude) $ strOption
 		( long "include" <> short 'I' <> metavar paramGlob
 		<> help "limit to files matching the glob pattern"
 		<> hidden
 		)
-	, globalSetter (Limit.addLargerThan lb) $ strOption
+	, globalOption (setAnnexState . Limit.addLargerThan lb) $ strOption
 		( long "largerthan" <> metavar paramSize
 		<> help "match files larger than a size"
 		<> hidden
 		)
-	, globalSetter (Limit.addSmallerThan lb) $ strOption
+	, globalOption (setAnnexState . Limit.addSmallerThan lb) $ strOption
 		( long "smallerthan" <> metavar paramSize
 		<> help "match files smaller than a size"
 		<> hidden
@@ -358,17 +359,19 @@ combiningOptions =
 	, shortopt ')' "close group of options"
 	]
   where
-	longopt o h = globalFlag (Limit.addSyntaxToken o) ( long o <> help h <> hidden )
+	longopt o h = globalFlag (setAnnexState $ Limit.addSyntaxToken o)
-	shortopt o h = globalFlag (Limit.addSyntaxToken [o]) ( short o <> help h <> hidden )
+		( long o <> help h <> hidden )
+	shortopt o h = globalFlag (setAnnexState $ Limit.addSyntaxToken [o])
+		( short o <> help h <> hidden )
 
 jsonOptions :: [GlobalOption]
 jsonOptions = 
-	[ globalFlag (Annex.setOutput (JSONOutput stdjsonoptions))
+	[ globalFlag (setAnnexState $ Annex.setOutput (JSONOutput stdjsonoptions))
 		( long "json" <> short 'j'
 		<> help "enable JSON output"
 		<> hidden
 		)
-	, globalFlag (Annex.setOutput (JSONOutput jsonerrormessagesoptions))
+	, globalFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonerrormessagesoptions))
 		( long "json-error-messages"
 		<> help "include error messages in JSON"
 		<> hidden
@@ -383,7 +386,7 @@ jsonOptions =
 
 jsonProgressOption :: [GlobalOption]
 jsonProgressOption = 
-	[ globalFlag (Annex.setOutput (JSONOutput jsonoptions))
+	[ globalFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonoptions))
 		( long "json-progress"
 		<> help "include progress in JSON output"
 		<> hidden
@@ -399,7 +402,7 @@ jsonProgressOption =
 -- action in `allowConcurrentOutput`.
 jobsOption :: [GlobalOption]
 jobsOption = 
-	[ globalSetter (setConcurrency . ConcurrencyCmdLine) $ 
+	[ globalOption (setAnnexState . setConcurrency . ConcurrencyCmdLine) $ 
 		option (maybeReader parseConcurrency)
 			( long "jobs" <> short 'J' 
 			<> metavar (paramNumber `paramOr` "cpus")
@@ -410,14 +413,14 @@ jobsOption =
 
 timeLimitOption :: [GlobalOption]
 timeLimitOption = 
-	[ globalSetter settimelimit $ option (eitherReader parseDuration)
+	[ globalOption settimelimit $ option (eitherReader parseDuration)
 		( long "time-limit" <> short 'T' <> metavar paramTime
 		<> help "stop after the specified amount of time"
 		<> hidden
 		)
 	]
   where
-	settimelimit duration = do
+	settimelimit duration = setAnnexState $ do
 		start <- liftIO getPOSIXTime
 		let cutoff = start + durationToPOSIXTime duration
 		Annex.changeState $ \s -> s { Annex.timelimit = Just (duration, cutoff) }

CmdLine/GitAnnexShell.hs

@@ -74,7 +74,7 @@ addGlobalOptions c = c { cmdglobaloptions = globalOptions ++ cmdglobaloptions c
 
 globalOptions :: [GlobalOption]
 globalOptions = 
-	globalSetter checkUUID (strOption
+	globalOption (setAnnexState . checkUUID) (strOption
 		( long "uuid" <> metavar paramUUID
 		<> help "local repository uuid"
 		))

CmdLine/GlobalSetter.hs

@@ -7,19 +7,30 @@
   
 module CmdLine.GlobalSetter where
 
-import Types.DeferredParse
 import Common
 import Annex
+import Types.DeferredParse
 
 import Options.Applicative
 
-globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> GlobalOption
+setAnnexState :: Annex () -> GlobalSetter
-globalFlag setter = flag' (DeferredParse setter) 
+setAnnexState a = GlobalSetter a id
 
-globalSetter :: (v -> Annex ()) -> Parser v -> GlobalOption
+setAnnexRead :: (AnnexRead -> AnnexRead) -> GlobalSetter
-globalSetter setter parser = DeferredParse . setter <$> parser
+setAnnexRead f = GlobalSetter (return ()) f
 
+globalFlag :: GlobalSetter -> Mod FlagFields GlobalSetter -> GlobalOption
+globalFlag = flag'
+
+globalOption :: (v -> GlobalSetter) -> Parser v -> GlobalOption
+globalOption mk parser = mk <$> parser
+
+-- | Combines a bunch of GlobalOptions together into a Parser
+-- that returns a GlobalSetter that can be used to set all the options that
+-- are enabled.
 parserGlobalOptions :: [GlobalOption] -> Parser GlobalSetter
-parserGlobalOptions [] = DeferredParse <$> pure noop
+parserGlobalOptions [] = pure mempty
-parserGlobalOptions l = DeferredParse . mapM_ getParsed
+parserGlobalOptions l = mconcat <$> many (foldl1 (<|>) l)
-	<$> many (foldl1 (<|>) l)
+
+applyAnnexReadSetter :: GlobalSetter -> (AnnexState, AnnexRead) -> (AnnexState, AnnexRead)
+applyAnnexReadSetter gs (st, rd) = (st, annexReadSetter gs rd)

CmdLine/Option.hs

@@ -20,46 +20,47 @@ import Types.GitConfig
 import Git.Types (ConfigKey(..))
 import Git.Config
 import Utility.FileSystemEncoding
+import Annex.Debug
 
 -- Global options accepted by both git-annex and git-annex-shell sub-commands.
 commonGlobalOptions :: [GlobalOption]
 commonGlobalOptions =
-	[ globalFlag (setforce True)
+	[ globalFlag (setAnnexState $ setforce True)
 		( long "force" 
 		<> help "allow actions that may lose annexed data"
 		<> hidden
 		)
-	, globalFlag (setfast True)
+	, globalFlag (setAnnexState $ setfast True)
 		( long "fast" <> short 'F'
 		<> help "avoid slow operations"
 		<> hidden
 		)
-	, globalFlag (Annex.setOutput QuietOutput)
+	, globalFlag (setAnnexState $ Annex.setOutput QuietOutput)
 		( long "quiet" <> short 'q'
 		<> help "avoid verbose output"
 		<> hidden
 		)
-	, globalFlag (Annex.setOutput NormalOutput)
+	, globalFlag (setAnnexState $ Annex.setOutput NormalOutput)
 		( long "verbose" <> short 'v'
 		<> help "allow verbose output (default)"
 		<> hidden
 		)
-	, globalFlag (setdebug True)
+	, globalFlag (setAnnexState $ setdebug True)
 		( long "debug" <> short 'd'
 		<> help "show debug messages"
 		<> hidden
 		)
-	, globalFlag (setdebug False)
+	, globalFlag (setAnnexState $ setdebug False)
 		( long "no-debug"
 		<> help "don't show debug messages"
 		<> hidden
 		)
-	, globalSetter setdebugfilter $ strOption
+	, globalOption setdebugfilter $ strOption
 		( long "debugfilter" <> metavar "NAME[,NAME..]"
 		<> help "show debug messages coming from a module"
 		<> hidden
 		)
-	, globalSetter setforcebackend $ strOption
+	, globalOption setforcebackend $ strOption
 		( long "backend" <> short 'b' <> metavar paramName
 		<> help "specify key-value backend to use"
 		<> hidden
@@ -67,13 +68,26 @@ commonGlobalOptions =
 	]
   where
 	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
+
 	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
-	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
+
+	setforcebackend v = setAnnexState $
+		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 v = Annex.addGitConfigOverride $
 		decodeBS' $ debugconfig <> "=" <> boolConfig' v
-	setdebugfilter v = Annex.addGitConfigOverride $ 
+	
-		decodeBS' (debugfilterconfig <> "=") ++ v
+	setdebugfilter v = mconcat
+		[ setAnnexRead $ \rd -> rd
+			{ Annex.debugselector = parseDebugSelector v
+			}
+		-- Also set in git config so it will be passed on to any
+		-- git-annex child processes.
+		, setAnnexState $ Annex.addGitConfigOverride $ 
+			decodeBS' (debugfilterconfig <> "=") ++ v
+		]
+	
 	(ConfigKey debugconfig) = annexConfig "debug"
 	(ConfigKey debugfilterconfig) = annexConfig "debugfilter"

Messages.hs

@@ -64,7 +64,7 @@ import Types.Command (StartMessage(..), SeekInput)
 import Types.Transfer (transferKey)
 import Messages.Internal
 import Messages.Concurrent
-import Utility.Debug
+import Annex.Debug
 import Annex.Concurrent.Utility
 import qualified Messages.JSON as JSON
 import qualified Annex
@@ -251,7 +251,7 @@ showRaw s = outputMessage JSON.none (s <> "\n")
 setupConsole :: IO ()
 setupConsole = do
 	dd <- debugDisplayer
-	configureDebug dd mempty
+	configureDebug dd (DebugSelector (const False))
 	{- Force output to be line buffered. This is normally the case when
 	 - it's connected to a terminal, but may not be when redirected to
 	 - a file or a pipe. -}
@@ -260,17 +260,14 @@ setupConsole = do
 
 enableDebugOutput :: Annex ()
 enableDebugOutput = do
-	names <- map encodeBS . annexDebugFilter <$> Annex.getGitConfig
+	selector <- Annex.getRead Annex.debugselector
-	let selector
-		| null names = const True
-		| otherwise = \(DebugSource s) -> any (`S.isInfixOf` s) names
 	dd <- liftIO debugDisplayer
-	liftIO $ configureDebug dd (DebugSelector selector)
+	liftIO $ configureDebug dd selector
 
 disableDebugOutput :: Annex ()
 disableDebugOutput = liftIO $ do
 	dd <- debugDisplayer
-	configureDebug dd mempty
+	configureDebug dd (DebugSelector (const False))
 
 debugDisplayer :: IO (S.ByteString -> IO ())
 debugDisplayer = do

Types/DeferredParse.hs

@@ -1,6 +1,6 @@
 {- git-annex deferred parse values
  -
- - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -12,6 +12,8 @@ module Types.DeferredParse where
 import Annex
 
 import Options.Applicative
+import qualified Data.Semigroup as Sem
+import Prelude
 
 -- Some values cannot be fully parsed without performing an action.
 -- The action may be expensive, so it's best to call finishParse on such a
@@ -36,6 +38,20 @@ instance DeferredParseClass (Maybe (DeferredParse a)) where
 instance DeferredParseClass [DeferredParse a] where
 	finishParse v = mapM finishParse v
 
--- Use when the Annex action modifies Annex state.
-type GlobalSetter = DeferredParse ()
 type GlobalOption = Parser GlobalSetter
+
+-- Used for global options that can modify Annex state by running
+-- an arbitrary action in it, and can also set up AnnexRead.
+data GlobalSetter = GlobalSetter
+	{ annexStateSetter :: Annex ()
+	, annexReadSetter :: AnnexRead -> AnnexRead
+	}
+
+instance Sem.Semigroup GlobalSetter where
+	a <> b = GlobalSetter
+		{ annexStateSetter = annexStateSetter a >> annexStateSetter b
+		, annexReadSetter = annexReadSetter b . annexReadSetter a
+		}
+
+instance Monoid GlobalSetter where
+	mempty = GlobalSetter (return ()) id

Types/GitConfig.hs

@@ -90,7 +90,7 @@ data GitConfig = GitConfig
 	, annexSyncContent :: GlobalConfigurable Bool
 	, annexSyncOnlyAnnex :: GlobalConfigurable Bool
 	, annexDebug :: Bool
-	, annexDebugFilter :: [String]
+	, annexDebugFilter :: Maybe String
 	, annexWebOptions :: [String]
 	, annexYoutubeDlOptions :: [String]
 	, annexAriaTorrentOptions :: [String]
@@ -171,8 +171,7 @@ extractGitConfig configsource r = GitConfig
 	, annexSyncOnlyAnnex = configurable False $ 
 		getmaybebool (annexConfig "synconlyannex")
 	, annexDebug = getbool (annexConfig "debug") False
-	, annexDebugFilter = maybe [] (splitc ',') $
+	, annexDebugFilter = getmaybe (annexConfig "debugfilter")
-		getmaybe (annexConfig "debugfilter")
 	, annexWebOptions = getwords (annexConfig "web-options")
 	, annexYoutubeDlOptions = getwords (annexConfig "youtube-dl-options")
 	, annexAriaTorrentOptions = getwords (annexConfig "aria-torrent-options")

git-annex.cabal

@@ -627,6 +627,8 @@ Executable git-annex
     Annex.Content.LowLevel
     Annex.Content.PointerFile
     Annex.CurrentBranch
+    Annex.Debug
+    Annex.Debug.Utility
     Annex.Difference
     Annex.DirHashes
     Annex.Drop