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:
parent
13c090b37a
commit
2e9d4ac754
5 changed files with 19 additions and 14 deletions
2
Annex.hs
2
Annex.hs
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue