From 409572c9e4c0c77814a5b448d26cf87054b07874 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 25 Jul 2023 15:47:58 -0400
Subject: [PATCH] use existing debug machinery for explain

explain is a kind of debug message, but not formatted in the same way.
So it makes sense to reuse the debug machinery for it, since that is
already quite optimised.

Sponsored-by: Dartmouth College's DANDI project
---
 Annex/Debug.hs   | 15 +++++++++++----
 Messages.hs      |  6 ++++++
 Utility/Debug.hs | 44 ++++++++++++++++++++++++++++++++------------
 3 files changed, 49 insertions(+), 16 deletions(-)

diff --git a/Annex/Debug.hs b/Annex/Debug.hs
index f3626ffaa1..e2f04b4f9a 100644
--- a/Annex/Debug.hs
+++ b/Annex/Debug.hs
@@ -1,6 +1,6 @@
 {- git-annex debugging
  -
- - Copyright 2021 Joey Hess <id@joeyh.name>
+ - Copyright 2021-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -8,8 +8,11 @@
 module Annex.Debug (
 	DebugSelector(..),
 	DebugSource(..),
+	RawDebugMessage(..),
 	debug,
+	debug',
 	fastDebug,
+	fastDebug',
 	configureDebug,
 	debugSelectorFromGitConfig,
 	parseDebugSelector,
@@ -17,7 +20,7 @@ module Annex.Debug (
 
 import Common
 import qualified Annex
-import Utility.Debug hiding (fastDebug)
+import Utility.Debug hiding (fastDebug, fastDebug')
 import qualified Utility.Debug
 import Annex.Debug.Utility
 
@@ -25,7 +28,11 @@ import Annex.Debug.Utility
 -- 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
+fastDebug = fastDebug'
+
+fastDebug' :: DebugMessage msg => DebugSource -> msg -> Annex.Annex ()
+fastDebug' src msg = do
 	rd <- Annex.getRead id
 	when (Annex.debugenabled rd) $
-		liftIO $ Utility.Debug.fastDebug (Annex.debugselector rd) src msg
+		liftIO $ Utility.Debug.fastDebug' (Annex.debugselector rd) src msg
+	
diff --git a/Messages.hs b/Messages.hs
index 7d865b29d6..5a318a2c68 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -50,6 +50,7 @@ module Messages (
 	outputMessage,
 	withMessageState,
 	MessageState,
+	explain,
 	prompt,
 	mkPrompter,
 	sanitizeTopLevelExceptionMessages,
@@ -281,6 +282,11 @@ debugDisplayer = do
 		S.hPutStr stderr (safeOutput s <> "\n")
 		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
  - output disabled? -}
 commandProgressDisabled :: Annex Bool
diff --git a/Utility/Debug.hs b/Utility/Debug.hs
index 6e6e701162..b7fe471f2e 100644
--- a/Utility/Debug.hs
+++ b/Utility/Debug.hs
@@ -1,6 +1,6 @@
 {- Debug output
  -
- - Copyright 2021 Joey Hess <id@joeyh.name>
+ - Copyright 2021-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -12,10 +12,14 @@
 module Utility.Debug (
 	DebugSource(..),
 	DebugSelector(..),
+	DebugMessage,
+	RawDebugMessage(..),
 	configureDebug,
 	getDebugSelector,
 	debug,
-	fastDebug
+	debug',
+	fastDebug,
+	fastDebug'
 ) where
 
 import qualified Data.ByteString as S
@@ -50,6 +54,22 @@ instance Sem.Semigroup DebugSelector where
 instance Monoid DebugSelector where
 	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.
 configureDebug
 	:: (S.ByteString -> IO ())
@@ -76,7 +96,10 @@ debugConfigGlobal = unsafePerformIO $ newIORef (dontshow, selectnone)
 -- have to consult a IORef each time, using it in a tight loop may slow
 -- down the program.
 debug :: DebugSource -> String -> IO ()
-debug src msg = readIORef debugConfigGlobal >>= \case
+debug = debug'
+
+debug' :: DebugMessage msg => DebugSource -> msg -> IO ()
+debug' src msg = readIORef debugConfigGlobal >>= \case
 	(displayer, NoDebugSelector) ->
 		displayer =<< formatDebugMessage src msg
 	(displayer, DebugSelector p)
@@ -88,15 +111,12 @@ debug src msg = readIORef debugConfigGlobal >>= \case
 -- When the DebugSelector does not let the message be displayed, this runs
 -- very quickly, allowing it to be used inside tight loops.
 fastDebug :: DebugSelector -> DebugSource -> String -> IO ()
-fastDebug NoDebugSelector src msg = do
+fastDebug = fastDebug'
+
+fastDebug' :: DebugMessage msg => DebugSelector -> DebugSource -> msg -> IO ()
+fastDebug' NoDebugSelector src msg = do
 	(displayer, _) <- readIORef debugConfigGlobal
 	displayer =<< formatDebugMessage src msg
-fastDebug (DebugSelector p) src msg
-	| p src = fastDebug NoDebugSelector src msg
+fastDebug' (DebugSelector p) src msg
+	| p src = fastDebug' NoDebugSelector src msg
 	| 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)