log alerts in notice mode, which is enabled by default
This commit is contained in:
parent
85c8b222a0
commit
b635d99f66
4 changed files with 27 additions and 17 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
14
Messages.hs
14
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
|
||||
|
||||
|
|
11
Option.hs
11
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 =
|
||||
|
|
Loading…
Reference in a new issue