Tweak Log a bit

Add log domain to Log format Update global logger so it never logs to stderr
alip · Jun 13, 2010 · faf55f4 · faf55f4
1 parent 35690cf
commit faf55f4
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 10 deletions.
diff --git 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
@@ -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,16 +165,19 @@ 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
         ]
     where
         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
@@ -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)