Revert "use existing debug machinery for explain"
This reverts commit 409572c9e4
.
This commit is contained in:
parent
409572c9e4
commit
cf40e2d4b6
3 changed files with 16 additions and 49 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue