ENH log plugins in file

lib/Data/Internal/XIO.hs

@@ -99,6 +99,7 @@ module Data.Internal.XIO
   , process
   -- misc
   , shellTest
+  , withLogFile
   )
 where
 
@@ -132,16 +133,19 @@ import XMonad.Internal.Theme
 -- | Run feature evaluation(s) with the cache
 -- Currently there is no easy way to not use this (oh well)
 runXIO :: FilePath -> XIO a -> IO a
-runXIO logfile x = do
+runXIO logfile x = withLogFile logfile $ runXIOInner x
-  -- TODO this directory will not exist on a fresh system
+
-  p <- (</> logfile) . dataDir <$> getDirectories
+withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
-  catchIO (withFile p AppendMode $ runXIOInner x) $ \e -> do
+withLogFile logfile f = do
-    print e
+  p <- (</> logfile) . dataDir <$> liftIO getDirectories
-    putStrLn "could not open log file, falling back to stderr"
+  catchIO (withFile p AppendMode f) $ \e -> do
-    runXIOInner x stderr
+    liftIO $ print e
+    liftIO $ putStrLn "could not open log file, falling back to stderr"
+    f stderr
 
 runXIOInner :: XIO a -> Handle -> IO a
 runXIOInner x h = do
+  hSetBuffering h LineBuffering
   logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
   pc <- mkDefaultProcessContext
   withLogFunc logOpts $ \f -> do

lib/Xmobar/Plugins/BacklightCommon.hs

@@ -13,7 +13,7 @@ import Xmobar.Plugins.Common
 
 startBacklight
   :: (MonadUnliftIO m, RealFrac a)
-  => Utf8Builder
+  => Maybe FilePath
   -> ((Maybe a -> DIO SimpleApp SesClient ()) -> DIO SimpleApp SesClient ())
   -> DIO SimpleApp SesClient (Maybe a)
   -> T.Text

lib/Xmobar/Plugins/Bluetooth.hs

@@ -65,7 +65,7 @@ data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 instance Exec Bluetooth where
   alias (Bluetooth _ _) = T.unpack btAlias
   start (Bluetooth icons colors) cb =
-    withDBusClientConnection cb "bluetooth" $ startAdapter icons colors cb
+    withDBusClientConnection cb (Just "bluetooth.log") $ startAdapter icons colors cb
 
 startAdapter
   :: Icons

lib/Xmobar/Plugins/ClevoKeyboard.hs

@@ -25,4 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
   alias (ClevoKeyboard _) = T.unpack ckAlias
   start (ClevoKeyboard icon) =
-    startBacklight "clevo keyboard" matchSignalCK callGetBrightnessCK icon
+    startBacklight (Just "clevo_kbd.log") matchSignalCK callGetBrightnessCK icon

lib/Xmobar/Plugins/Common.hs

@@ -12,12 +12,14 @@ module Xmobar.Plugins.Common
   , displayMaybe
   , displayMaybe'
   , xmobarFGColor
+  , LogConf (..)
   )
 where
 
 import DBus
 import DBus.Client
 import Data.Internal.DBus
+import Data.Internal.XIO
 import RIO
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)
@@ -75,13 +77,21 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
   :: (MonadUnliftIO m, SafeClient c)
   => Callback
-  -> Utf8Builder
+  -> Maybe FilePath
   -> (c -> RIO SimpleApp ())
   -> m ()
-withDBusClientConnection cb name f = do
+withDBusClientConnection cb logfile f =
-  logOpts <- setLogVerboseFormat True . setLogUseTime True . setLogFormat pre <$> logOptionsHandle stderr False
+  maybe (run stderr) (`withLogFile` run) logfile
-  withLogFunc logOpts $ \lf -> do
-    env <- mkSimpleApp lf Nothing
-    runRIO env $ displayMaybe' cb f =<< getDBusClient
   where
-    pre rest = "[" <> name <> " plugin] " <> rest
+    run h = do
+      logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
+      withLogFunc logOpts $ \lf -> do
+        env <- mkSimpleApp lf Nothing
+        runRIO env $ displayMaybe' cb f =<< getDBusClient
+
+data LogConf = LogConf
+  { lcLevel :: !LogLevel
+  , lcVerbose :: !Bool
+  , lcPath :: FilePath
+  }
+  deriving (Show, Read)

lib/Xmobar/Plugins/Device.hs

@@ -80,7 +80,7 @@ instance Exec Device where
       path <- getDevice iface
       displayMaybe' cb listener path
     where
-      logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
+      logName = Just $ T.unpack $ T.concat ["device@", iface, ".log"]
       listener path = do
         res <- matchPropertyFull networkManagerBus (Just path)
         case res of

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -25,4 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
   alias (IntelBacklight _) = T.unpack blAlias
   start (IntelBacklight icon) =
-    startBacklight "intel backlight" matchSignalIB callGetBrightnessIB icon
+    startBacklight (Just "intel_backlight.log") matchSignalIB callGetBrightnessIB icon

lib/Xmobar/Plugins/Screensaver.hs

@@ -26,7 +26,7 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb =
-    withDBusClientConnection cb "screensaver" $ \cl -> withDIO cl $ do
+    withDBusClientConnection cb (Just "screensaver.log") $ \cl -> withDIO cl $ do
       matchSignal dpy
       dpy =<< callQuery
     where

lib/Xmobar/Plugins/VPN.hs

@@ -32,7 +32,7 @@ newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
 instance Exec VPN where
   alias (VPN _) = T.unpack vpnAlias
   start (VPN (text, colors)) cb =
-    withDBusClientConnection cb "VPN" $ \c -> do
+    withDBusClientConnection cb (Just "vpn.log") $ \c -> do
       let dpy = displayMaybe cb iconFormatter . Just =<< readState
       s <- newEmptyMVar
       mapRIO (VEnv c s dpy) $ do