fix fastDebug to check if debugging is actually enabled

Had to add to AnnexRead an indication of whether debugging is enabled.

Could have just made setupConsole not install a debug output action that
outputs, and have enableDebug be what installs that, but then in the
common case where there is no debug selector, and so all debug output is
selected, it would run the debug output action every time, which entails
an IORef access. Which would make fastDebug too slow..
This commit is contained in:
Joey Hess 2021-04-06 16:28:37 -04:00
parent 13c090b37a
commit 2e9d4ac754
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 19 additions and 14 deletions

View file

@ -120,6 +120,7 @@ data AnnexRead = AnnexRead
, sshstalecleaned :: TMVar Bool , sshstalecleaned :: TMVar Bool
, signalactions :: TVar (M.Map SignalAction (Int -> IO ())) , signalactions :: TVar (M.Map SignalAction (Int -> IO ()))
, transferrerpool :: TransferrerPool , transferrerpool :: TransferrerPool
, debugenabled :: Bool
, debugselector :: DebugSelector , debugselector :: DebugSelector
} }
@ -138,6 +139,7 @@ newAnnexRead c = do
, sshstalecleaned = sc , sshstalecleaned = sc
, signalactions = si , signalactions = si
, transferrerpool = tp , transferrerpool = tp
, debugenabled = annexDebug c
, debugselector = debugSelectorFromGitConfig c , debugselector = debugSelectorFromGitConfig c
} }

View file

@ -26,5 +26,6 @@ import Annex.Debug.Utility
-- when debugging is not enabled. -- when debugging is not enabled.
fastDebug :: DebugSource -> String -> Annex.Annex () fastDebug :: DebugSource -> String -> Annex.Annex ()
fastDebug src msg = do fastDebug src msg = do
selector <- Annex.getRead Annex.debugselector rd <- Annex.getRead id
liftIO $ Utility.Debug.fastDebug selector src msg when (Annex.debugenabled rd) $
liftIO $ Utility.Debug.fastDebug (Annex.debugselector rd) src msg

View file

@ -142,14 +142,14 @@ subCmdName argv = (name, args)
| otherwise = (Just a, reverse c ++ as) | otherwise = (Just a, reverse c ++ as)
-- | Note that the GlobalSetter must have already had its annexReadSetter -- | Note that the GlobalSetter must have already had its annexReadSetter
-- applied before entering the Annex monad; that cannot be changed while -- applied before entering the Annex monad to run this; that cannot be
-- running in the Annex monad. -- changed while running in the Annex monad.
prepRunCommand :: Command -> GlobalSetter -> Annex () prepRunCommand :: Command -> GlobalSetter -> Annex ()
prepRunCommand cmd globalsetter = do prepRunCommand cmd globalsetter = do
when (cmdnomessages cmd) $ when (cmdnomessages cmd) $
Annex.setOutput QuietOutput Annex.setOutput QuietOutput
annexStateSetter globalsetter annexStateSetter globalsetter
whenM (annexDebug <$> Annex.getGitConfig) $ whenM (Annex.getRead Annex.debugenabled) $
enableDebugOutput enableDebugOutput
findAddonCommand :: Maybe String -> IO (Maybe Command) findAddonCommand :: Maybe String -> IO (Maybe Command)

View file

@ -45,12 +45,12 @@ commonGlobalOptions =
<> help "allow verbose output (default)" <> help "allow verbose output (default)"
<> hidden <> hidden
) )
, globalFlag (setAnnexState $ setdebug True) , globalFlag (setdebug True)
( long "debug" <> short 'd' ( long "debug" <> short 'd'
<> help "show debug messages" <> help "show debug messages"
<> hidden <> hidden
) )
, globalFlag (setAnnexState $ setdebug False) , globalFlag (setdebug False)
( long "no-debug" ( long "no-debug"
<> help "don't show debug messages" <> help "don't show debug messages"
<> hidden <> hidden
@ -74,15 +74,17 @@ commonGlobalOptions =
setforcebackend v = setAnnexState $ setforcebackend v = setAnnexState $
Annex.changeState $ \s -> s { Annex.forcebackend = Just v } Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
-- Overriding this way, rather than just setting annexDebug setdebug v = mconcat
-- makes the config be passed on to any git-annex child processes. [ setAnnexRead $ \rd -> rd { Annex.debugenabled = v }
setdebug v = Annex.addGitConfigOverride $ -- Also set in git config so it will be passed on to any
decodeBS' $ debugconfig <> "=" <> boolConfig' v -- git-annex child processes.
, setAnnexState $ Annex.addGitConfigOverride $
decodeBS' $ debugconfig <> "=" <> boolConfig' v
]
setdebugfilter v = mconcat setdebugfilter v = mconcat
[ setAnnexRead $ \rd -> rd [ setAnnexRead $ \rd -> rd
{ Annex.debugselector = parseDebugSelector v { Annex.debugselector = parseDebugSelector v }
}
-- Also set in git config so it will be passed on to any -- Also set in git config so it will be passed on to any
-- git-annex child processes. -- git-annex child processes.
, setAnnexState $ Annex.addGitConfigOverride $ , setAnnexState $ Annex.addGitConfigOverride $

View file

@ -59,7 +59,7 @@ git_annex_shell cs r command params fields
dir = Git.repoPath r dir = Git.repoPath r
shellcmd = "git-annex-shell" shellcmd = "git-annex-shell"
getshellopts = do getshellopts = do
debugenabled <- annexDebug <$> Annex.getGitConfig debugenabled <- Annex.getRead Annex.debugenabled
let params' = if debugenabled let params' = if debugenabled
then Param "--debug" : params then Param "--debug" : params
else params else params