ENH log plugins in file
This commit is contained in:
parent
6c3d8c3eaf
commit
1142732dca
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue