From faf55f4141a6d72f6c0c50bb2106e1a0b25fdc10 Mon Sep 17 00:00:00 2001 From: Ali Polatel Date: Sun, 13 Jun 2010 22:38:47 +0300 Subject: [PATCH] Tweak Log a bit Add log domain to Log format Update global logger so it never logs to stderr --- src/Qoropa/Buffer/Log.hs | 9 +++++++-- src/Qoropa/Config.hs | 11 +++++++---- src/Qoropa/UI.hs | 12 ++++++++---- 3 files changed, 22 insertions(+), 10 deletions(-) diff --git a/src/Qoropa/Buffer/Log.hs b/src/Qoropa/Buffer/Log.hs index 62ffb27..d231fba 100644 --- a/src/Qoropa/Buffer/Log.hs +++ b/src/Qoropa/Buffer/Log.hs @@ -55,6 +55,7 @@ import {-# SOURCE #-} Qoropa.UI (UIEvent(..)) data LineData = LineData { lineDataTime :: ZonedTime , lineDataRecord :: LogRecord + , lineDataDomain :: String } data StatusBar = StatusBar @@ -69,6 +70,7 @@ data Attributes = Attributes , attrStatusMessage :: Attr , attrFill :: Attr , attrTime :: (Attr, Attr) + , attrDomain :: (Attr, Attr) , attrPriority :: (Attr, Attr) , attrMessage :: (Attr, Attr) , attrDefault :: (Attr, Attr) @@ -201,13 +203,16 @@ handler (ref, lock) mvar pri = } where myWriteFunc :: () -> LogRecord -> String -> IO () - myWriteFunc _ record _ = do + myWriteFunc _ record domain = do now <- getZonedTime Lock.with lock $ do buf <- readIORef ref let len = listLength $ bufferList buf theme = bufferTheme buf - line = Line { lineData = LineData { lineDataTime = now, lineDataRecord = record } + line = Line { lineData = LineData { lineDataTime = now + , lineDataRecord = record + , lineDataDomain = domain + } , lineRender = (themeDrawLine theme) (themeAttrs theme) } writeIORef ref buf { bufferList = listAppend (bufferList buf) line diff --git a/src/Qoropa/Config.hs b/src/Qoropa/Config.hs index 2cbf877..eaaa133 100644 --- a/src/Qoropa/Config.hs +++ b/src/Qoropa/Config.hs @@ -55,7 +55,6 @@ import {-# SOURCE #-} Qoropa.UI ( UI(..) , redraw, exit , selectPrev, selectNext - , scrollDown, scrollUp , openSelected, cancelOperation , switchBuffer, switchBufferNext, switchBufferPrev ) @@ -137,6 +136,9 @@ defaultLogAttributes = Log.Attributes , Log.attrTime = ( def_attr `with_fore_color` white , def_attr `with_back_color` yellow `with_fore_color` black ) + , Log.attrDomain = ( def_attr `with_fore_color` magenta + , def_attr `with_back_color` yellow `with_fore_color` magenta `with_style` bold + ) , Log.attrPriority = ( def_attr `with_fore_color` green , def_attr `with_back_color` yellow `with_fore_color` blue `with_style` bold ) @@ -163,6 +165,7 @@ logDrawLine :: Log.Attributes -> Log.LineData -> Bool -> Image logDrawLine attr ld sel = horiz_cat $ intersperse (char myDefaultAttribute ' ') [ string myTimeAttribute myTimeFormat + , string myDomainAttribute myDomainFormat , string myPriorityAttribute myPriorityFormat , string myMessageAttribute myMessageFormat ] @@ -170,9 +173,11 @@ logDrawLine attr ld sel = f = if sel then snd else fst myDefaultAttribute = f $ Log.attrDefault attr myTimeAttribute = f $ Log.attrTime attr + myDomainAttribute = f $ Log.attrDomain attr myPriorityAttribute = f $ Log.attrPriority attr myMessageAttribute = f $ Log.attrMessage attr - myTimeFormat = formatTime defaultTimeLocale "%Y-%m-%d %T %z" (Log.lineDataTime ld) + myTimeFormat = formatTime defaultTimeLocale "%Y-%m-%d %T %z" $ Log.lineDataTime ld + myDomainFormat = printf "%-15s" $ Log.lineDataDomain ld myPriorityFormat = printf "%-7s" (show $ fst $ Log.lineDataRecord ld) myMessageFormat = snd $ Log.lineDataRecord ld @@ -297,8 +302,6 @@ defaultKeys = Map.fromList $ , ( EvKey (KASCII 'K') [], selectPrev 5 ) , ( EvKey KUp [], selectPrev 1 ) , ( EvKey KDown [], selectNext 1 ) - , ( EvKey (KASCII ' ') [], scrollDown 1 ) - , ( EvKey (KASCII 'n') [], scrollUp 1 ) , ( EvKey KEnter [], openSelected ) , ( EvKey (KASCII 'c') [MCtrl], cancelOperation ) , ( EvKey (KASCII 'j') [MMeta], switchBufferNext ) diff --git a/src/Qoropa/UI.hs b/src/Qoropa/UI.hs index d274216..99d1f3a 100644 --- a/src/Qoropa/UI.hs +++ b/src/Qoropa/UI.hs @@ -39,12 +39,13 @@ import System.Posix.Signals (raiseSignal, sigTSTP) import Data.Sequence (Seq) import qualified Data.Sequence as Seq -import qualified Data.Map as Map +import qualified Data.Map as Map (lookup) import System.Log.Logger ( updateGlobalLogger, rootLoggerName, setHandlers, setLevel , debugM, noticeM ) +import System.Log.Handler.Simple (GenericHandler(..)) import Graphics.Vty ( Vty, mkVtyEscDelay, reserve_display, shutdown, terminal, update @@ -259,10 +260,13 @@ mainLoop ui = do modifyIORef (bufSeq ui) (\sq -> sq Seq.|> (BufLog logRef, logLock)) writeIORef (bufCurrent ui) 0 + -- Logging to stderr is bad mmkay? + updateGlobalLogger rootLoggerName $ setHandlers ([] :: [GenericHandler ()]) + -- Add the log handler let logHandler = Log.handler (logRef, logLock) (uiEvent ui) (configLogPriority $ userConfig ui) - updateGlobalLogger rootLoggerName $ setLevel (configLogPriority $ userConfig ui) . setHandlers [logHandler] - noticeM rootLoggerName "Initialized" + updateGlobalLogger "Qoropa" $ setLevel (configLogPriority $ userConfig ui) . setHandlers [logHandler] + noticeM "Qoropa" "Welcome to Qoropa!" forkIO $ putMVar (uiEvent ui) NewFolder eventLoop path @@ -278,7 +282,7 @@ mainLoop ui = do _ -> case Map.lookup e (configKeys $ userConfig ui) of Just f -> f ui - Nothing -> debugM rootLoggerName $ "Unhandled event: " ++ show e + Nothing -> debugM "Qoropa" $ "Unhandled event: " ++ show e NewFolder -> do sq <- readIORef (bufSeq ui) ef <- Folder.emptyFolder (configThemeFolder $ userConfig ui)