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
-- 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
-- TODO this directory will not exist on a fresh system
p <- (</> logfile) . dataDir <$> getDirectories
catchIO (withFile p AppendMode $ runXIOInner x) $ \e -> do
print e
putStrLn "could not open log file, falling back to stderr"
runXIOInner x stderr
runXIO logfile x = withLogFile logfile $ runXIOInner x
withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
withLogFile logfile f = do
p <- (</> logfile) . dataDir <$> liftIO getDirectories
catchIO (withFile p AppendMode f) $ \e -> do
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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
logOpts <- setLogVerboseFormat True . setLogUseTime True . setLogFormat pre <$> logOptionsHandle stderr False
withDBusClientConnection cb logfile f =
maybe (run stderr) (`withLogFile` run) logfile
where
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
where
pre rest = "[" <> name <> " plugin] " <> rest
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
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

View File

@ -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

View File

@ -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

View File

@ -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