ENH log plugins in file

This commit is contained in:
Nathan Dwarshuis 2023-01-03 23:33:08 -05:00
parent 6c3d8c3eaf
commit 1142732dca
9 changed files with 35 additions and 21 deletions

View File

@ -99,6 +99,7 @@ module Data.Internal.XIO
, process , process
-- misc -- misc
, shellTest , shellTest
, withLogFile
) )
where where
@ -132,16 +133,19 @@ import XMonad.Internal.Theme
-- | Run feature evaluation(s) with the cache -- | Run feature evaluation(s) with the cache
-- Currently there is no easy way to not use this (oh well) -- Currently there is no easy way to not use this (oh well)
runXIO :: FilePath -> XIO a -> IO a 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 :: XIO a -> Handle -> IO a
runXIOInner x h = do runXIOInner x h = do
hSetBuffering h LineBuffering
logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
pc <- mkDefaultProcessContext pc <- mkDefaultProcessContext
withLogFunc logOpts $ \f -> do withLogFunc logOpts $ \f -> do

View File

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

View File

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

View File

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

View File

@ -12,12 +12,14 @@ module Xmobar.Plugins.Common
, displayMaybe , displayMaybe
, displayMaybe' , displayMaybe'
, xmobarFGColor , xmobarFGColor
, LogConf (..)
) )
where where
import DBus import DBus
import DBus.Client import DBus.Client
import Data.Internal.DBus import Data.Internal.DBus
import Data.Internal.XIO
import RIO import RIO
import qualified RIO.Text as T import qualified RIO.Text as T
import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Hooks.DynamicLog (xmobarColor)
@ -75,13 +77,21 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
withDBusClientConnection withDBusClientConnection
:: (MonadUnliftIO m, SafeClient c) :: (MonadUnliftIO m, SafeClient c)
=> Callback => Callback
-> Utf8Builder -> Maybe FilePath
-> (c -> RIO SimpleApp ()) -> (c -> RIO SimpleApp ())
-> m () -> 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 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)

View File

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

View File

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

View File

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

View File

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