log alerts in notice mode, which is enabled by default

This commit is contained in:
Joey Hess 2013-01-15 14:34:39 -04:00
parent 85c8b222a0
commit b635d99f66
4 changed files with 27 additions and 17 deletions

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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 =