log alerts in notice mode, which is enabled by default

4 files changed, 27 insertions, 17 deletions

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 01e18e5ab..f682657c9 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -187,7 +187,7 @@ notifyAlert = do
 {- Returns the alert's identifier, which can be used to remove it. -}
 addAlert :: Alert -> Assistant AlertId
 addAlert alert = do
-	debug [showAlert alert]
+	notice [showAlert alert]
 	notifyAlert `after` modifyDaemonStatus add
   where
 	add s = (s { lastAlertId = i, alertMap = m }, i)
diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs
index 569f787d1..0e122c097 100644
--- a/Assistant/Types/NamedThread.hs
+++ b/Assistant/Types/NamedThread.hs
@@ -5,7 +5,12 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Assistant.Types.NamedThread where
+module Assistant.Types.NamedThread (
+	ThreadName,
+	NamedThread(..),
+	debug,
+	notice,
+) where
 
 import Common.Annex
 import Assistant.Monad
@@ -16,6 +21,12 @@ type ThreadName = String
 data NamedThread = NamedThread ThreadName (Assistant ())
 
 debug :: [String] -> Assistant ()
-debug ws = do
+debug = logaction debugM
+
+notice :: [String] -> Assistant ()
+notice = logaction noticeM
+
+logaction :: (String -> String -> IO ()) -> [String] -> Assistant ()
+logaction a ws = do
 	name <- getAssistant threadName
-	liftIO $ debugM name $ unwords $ (name ++ ":") : ws
+	liftIO $ a name $ unwords $ (name ++ ":") : ws
diff --git a/Messages.hs b/Messages.hs
index d75fe6769..63c628108 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -38,6 +38,10 @@ import Text.JSON
 import Data.Progress.Meter
 import Data.Progress.Tracker
 import Data.Quantity
+import System.Log.Logger
+import System.Log.Formatter
+import System.Log.Handler (setFormatter, LogHandler)
+import System.Log.Handler.Simple
 
 import Common
 import Types
@@ -197,11 +201,15 @@ showHeader h = handle q $
 showRaw :: String -> Annex ()
 showRaw s = handle q $ putStrLn s
 
-{- This avoids ghc's output layer crashing on invalid encoded characters in
- - filenames when printing them out.
- -}
 setupConsole :: IO ()
 setupConsole = do
+	s <- setFormatter
+		<$> streamHandler stderr DEBUG
+		<*> pure (simpleLogFormatter "[$time] $msg")
+	updateGlobalLogger rootLoggerName (setLevel NOTICE . setHandlers [s])
+	{- This avoids ghc's output layer crashing on
+	 - invalid encoded characters in
+	 - filenames when printing them out. -}
 	fileEncoding stdout
 	fileEncoding stderr
 
diff --git a/Option.hs b/Option.hs
index 1475aafbe..78fc43438 100644
--- a/Option.hs
+++ b/Option.hs
@@ -17,9 +17,6 @@ module Option (
 
 import System.Console.GetOpt
 import System.Log.Logger
-import System.Log.Formatter
-import System.Log.Handler (setFormatter, LogHandler)
-import System.Log.Handler.Simple
 
 import Common.Annex
 import qualified Annex
@@ -51,13 +48,7 @@ common =
 	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
 	setauto v = Annex.changeState $ \s -> s { Annex.auto = v }
 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
-	setdebug = liftIO $ do
-		s <- simpledebug
-		updateGlobalLogger rootLoggerName
-			(setLevel DEBUG . setHandlers [s])
-	simpledebug = setFormatter
-		<$> streamHandler stderr DEBUG
-		<*> pure (simpleLogFormatter "[$time] $msg")
+	setdebug = liftIO $ updateGlobalLogger rootLoggerName $ setLevel DEBUG
 
 matcher :: [Option]
 matcher =