Revert "use existing debug machinery for explain"

This reverts commit 409572c9e4.
This commit is contained in:
Joey Hess 2023-07-25 15:53:50 -04:00
parent 409572c9e4
commit cf40e2d4b6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 16 additions and 49 deletions

View file

@ -1,6 +1,6 @@
{- git-annex debugging {- git-annex debugging
- -
- Copyright 2021-2023 Joey Hess <id@joeyh.name> - Copyright 2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -8,11 +8,8 @@
module Annex.Debug ( module Annex.Debug (
DebugSelector(..), DebugSelector(..),
DebugSource(..), DebugSource(..),
RawDebugMessage(..),
debug, debug,
debug',
fastDebug, fastDebug,
fastDebug',
configureDebug, configureDebug,
debugSelectorFromGitConfig, debugSelectorFromGitConfig,
parseDebugSelector, parseDebugSelector,
@ -20,7 +17,7 @@ module Annex.Debug (
import Common import Common
import qualified Annex import qualified Annex
import Utility.Debug hiding (fastDebug, fastDebug') import Utility.Debug hiding (fastDebug)
import qualified Utility.Debug import qualified Utility.Debug
import Annex.Debug.Utility import Annex.Debug.Utility
@ -28,11 +25,7 @@ import Annex.Debug.Utility
-- is read from the Annex monad, which avoids any IORef access overhead -- is read from the Annex monad, which avoids any IORef access overhead
-- when debugging is not enabled. -- when debugging is not enabled.
fastDebug :: DebugSource -> String -> Annex.Annex () fastDebug :: DebugSource -> String -> Annex.Annex ()
fastDebug = fastDebug' fastDebug src msg = do
fastDebug' :: DebugMessage msg => DebugSource -> msg -> Annex.Annex ()
fastDebug' src msg = do
rd <- Annex.getRead id rd <- Annex.getRead id
when (Annex.debugenabled rd) $ when (Annex.debugenabled rd) $
liftIO $ Utility.Debug.fastDebug' (Annex.debugselector rd) src msg liftIO $ Utility.Debug.fastDebug (Annex.debugselector rd) src msg

View file

@ -50,7 +50,6 @@ module Messages (
outputMessage, outputMessage,
withMessageState, withMessageState,
MessageState, MessageState,
explain,
prompt, prompt,
mkPrompter, mkPrompter,
sanitizeTopLevelExceptionMessages, sanitizeTopLevelExceptionMessages,
@ -282,11 +281,6 @@ debugDisplayer = do
S.hPutStr stderr (safeOutput s <> "\n") S.hPutStr stderr (safeOutput s <> "\n")
hFlush stderr hFlush stderr
explain :: Maybe String -> String -> Annex ()
explain Nothing _ = return ()
explain (Just f) msg = fastDebug' "explain" $
RawDebugMessage ('[' : f ++ " " ++ msg ++ "]")
{- Should commands that normally output progress messages have that {- Should commands that normally output progress messages have that
- output disabled? -} - output disabled? -}
commandProgressDisabled :: Annex Bool commandProgressDisabled :: Annex Bool

View file

@ -1,6 +1,6 @@
{- Debug output {- Debug output
- -
- Copyright 2021-2023 Joey Hess <id@joeyh.name> - Copyright 2021 Joey Hess <id@joeyh.name>
- -
- License: BSD-2-clause - License: BSD-2-clause
-} -}
@ -12,14 +12,10 @@
module Utility.Debug ( module Utility.Debug (
DebugSource(..), DebugSource(..),
DebugSelector(..), DebugSelector(..),
DebugMessage,
RawDebugMessage(..),
configureDebug, configureDebug,
getDebugSelector, getDebugSelector,
debug, debug,
debug', fastDebug
fastDebug,
fastDebug'
) where ) where
import qualified Data.ByteString as S import qualified Data.ByteString as S
@ -54,22 +50,6 @@ instance Sem.Semigroup DebugSelector where
instance Monoid DebugSelector where instance Monoid DebugSelector where
mempty = NoDebugSelector mempty = NoDebugSelector
class DebugMessage msg where
formatDebugMessage :: DebugSource -> msg -> IO S.ByteString
instance DebugMessage String where
formatDebugMessage (DebugSource src) msg = do
t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]"
<$> getZonedTime
return (t <> " (" <> src <> ") " <> encodeBS msg)
-- Debug message to be displayed without the usual time stamp
-- and source information.
newtype RawDebugMessage = RawDebugMessage String
instance DebugMessage RawDebugMessage where
formatDebugMessage _ (RawDebugMessage msg) = pure (encodeBS msg)
-- | Configures debugging. -- | Configures debugging.
configureDebug configureDebug
:: (S.ByteString -> IO ()) :: (S.ByteString -> IO ())
@ -96,10 +76,7 @@ debugConfigGlobal = unsafePerformIO $ newIORef (dontshow, selectnone)
-- have to consult a IORef each time, using it in a tight loop may slow -- have to consult a IORef each time, using it in a tight loop may slow
-- down the program. -- down the program.
debug :: DebugSource -> String -> IO () debug :: DebugSource -> String -> IO ()
debug = debug' debug src msg = readIORef debugConfigGlobal >>= \case
debug' :: DebugMessage msg => DebugSource -> msg -> IO ()
debug' src msg = readIORef debugConfigGlobal >>= \case
(displayer, NoDebugSelector) -> (displayer, NoDebugSelector) ->
displayer =<< formatDebugMessage src msg displayer =<< formatDebugMessage src msg
(displayer, DebugSelector p) (displayer, DebugSelector p)
@ -111,12 +88,15 @@ debug' src msg = readIORef debugConfigGlobal >>= \case
-- When the DebugSelector does not let the message be displayed, this runs -- When the DebugSelector does not let the message be displayed, this runs
-- very quickly, allowing it to be used inside tight loops. -- very quickly, allowing it to be used inside tight loops.
fastDebug :: DebugSelector -> DebugSource -> String -> IO () fastDebug :: DebugSelector -> DebugSource -> String -> IO ()
fastDebug = fastDebug' fastDebug NoDebugSelector src msg = do
fastDebug' :: DebugMessage msg => DebugSelector -> DebugSource -> msg -> IO ()
fastDebug' NoDebugSelector src msg = do
(displayer, _) <- readIORef debugConfigGlobal (displayer, _) <- readIORef debugConfigGlobal
displayer =<< formatDebugMessage src msg displayer =<< formatDebugMessage src msg
fastDebug' (DebugSelector p) src msg fastDebug (DebugSelector p) src msg
| p src = fastDebug' NoDebugSelector src msg | p src = fastDebug NoDebugSelector src msg
| otherwise = return () | otherwise = return ()
formatDebugMessage :: DebugSource -> String -> IO S.ByteString
formatDebugMessage (DebugSource src) msg = do
t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]"
<$> getZonedTime
return (t <> " (" <> src <> ") " <> encodeBS msg)