ENH use indiv logs for bluetooth devs

This commit is contained in:
Nathan Dwarshuis 2023-10-01 01:02:06 -04:00
parent 700f42d65c
commit 13ddeb3ba7
3 changed files with 58 additions and 52 deletions

View File

@ -40,11 +40,11 @@ instance Exec ActiveConnection where
alias (ActiveConnection (contypes, _, _)) = T.unpack $ connAlias contypes
start (ActiveConnection (contypes, text, colors)) cb =
withDBusClientConnection cb (Just "ethernet.log") $ \c -> do
let dpy = displayMaybe cb formatter . Just =<< readState
let dpy cb' = displayMaybe cb' formatter . Just =<< readState
i <- withDIO c $ initialState contypes
s <- newMVar i
let mapEnv c' = mapRIO (PluginEnv c' s dpy)
mapEnv c $ addListener mapEnv >> dpy
let mapEnv c' = mapRIO (PluginEnv c' s dpy cb)
mapEnv c $ addListener mapEnv >> pluginDisplay
where
formatter names = return $ case names of
[] -> colorText colors False text
@ -54,6 +54,10 @@ instance Exec ActiveConnection where
case res of
Nothing -> logError "could not start listener"
Just rule ->
-- Start a new connection and RIO process since the parent thread
-- will have died before these callbacks fire, therefore the logging
-- file descriptor will be closed. This makes a new one
-- TODO can I recycle the client?
void $
addMatchCallbackSignal rule $ \sig ->
withDBusClientConnection cb (Just "ethernet-cb.log") $ \c' ->
@ -119,11 +123,10 @@ updateDisconnected path = do
testActiveType :: NE.NonEmpty T.Text -> Signal -> EthIO ()
testActiveType contypes sig = do
dpy <- asks plugDisplay
case signalBody sig of
[state, _] -> case fromVariant state of
Just (2 :: Word32) -> updateConnected contypes path >> dpy
Just 4 -> updateDisconnected path >> dpy
Just (2 :: Word32) -> updateConnected contypes path >> pluginDisplay
Just 4 -> updateDisconnected path >> pluginDisplay
_ -> return ()
_ -> return ()
where

View File

@ -73,8 +73,8 @@ startAdapter
-> RIO SimpleApp ()
startAdapter is cs cb cl = do
state <- newMVar emptyState
let dpy = displayIcon cb (iconFormatter is cs)
mapRIO (BTEnv cl state dpy) $ do
let dpy cb' = displayIcon cb' (iconFormatter is cs)
mapRIO (PluginEnv cl state dpy cb) $ do
ot <- getBtObjectTree
case findAdapter ot of
Nothing -> logError "could not find bluetooth adapter"
@ -86,11 +86,17 @@ startAdapter is cs cb cl = do
let devices = findDevices adapter ot
addDeviceAddedListener adapter
addDeviceRemovedListener adapter
forM_ devices $ \d -> addAndInitDevice d
forM_ devices $ \d -> addAndInitDevice (deviceLogFile d) d
-- after setting things up, show the icon based on the initialized state
dpy
-- keep file descriptors open in callback threads
forever $ threadDelay 1000000
pluginDisplay
deviceLogFile :: ObjectPath -> FilePath
deviceLogFile =
T.unpack
. T.append "bluetooth"
. T.map (\c -> if c == '/' then '_' else c)
. T.pack
. formatObjectPath
--------------------------------------------------------------------------------
-- Icon Display
@ -121,20 +127,7 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
-- is to track the shared state of the bluetooth adaptor and its devices using
-- an MVar.
data BTEnv c = BTEnv
{ btClient :: !c
, btState :: !(MVar BtState)
, btDisplay :: !(BTIO ())
, btEnv :: !SimpleApp
}
instance HasClient BTEnv where
clientL = lens btClient (\x y -> x {btClient = y})
instance HasLogFunc (BTEnv a) where
logFuncL = lens btEnv (\x y -> x {btEnv = y}) . logFuncL
type BTIO = RIO (BTEnv SysClient)
type BTIO = PluginIO BtState SysClient
data BTDevice = BTDevice
{ btDevConnected :: Maybe Bool
@ -163,11 +156,11 @@ readState = do
modifyState :: (BtState -> BTIO (BtState, a)) -> BTIO a
modifyState f = do
m <- asks btState
m <- asks plugState
modifyMVar m f
beforeDisplay :: BTIO () -> BTIO ()
beforeDisplay f = f >> join (asks btDisplay)
beforeDisplay f = f >> pluginDisplay
--------------------------------------------------------------------------------
-- Object manager
@ -214,7 +207,7 @@ addDeviceAddedListener :: ObjectPath -> BTIO ()
addDeviceAddedListener adapter = addBtOMListener addDevice
where
addDevice = pathCallback adapter $ \d ->
addAndInitDevice d
addAndInitDevice (deviceLogFile d) d
addDeviceRemovedListener :: ObjectPath -> BTIO ()
addDeviceRemovedListener adapter =
@ -222,7 +215,7 @@ addDeviceRemovedListener adapter =
where
remDevice = pathCallback adapter $ \d -> do
old <- removeDevice d
cl <- asks btClient
cl <- asks plugClient
forM_ old $ liftIO . removeMatch (toClient cl) . btDevSigHandler
pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
@ -255,22 +248,20 @@ matchBTProperty
matchBTProperty p = matchPropertyFull btBus (Just p)
withBTPropertyRule
:: ( SafeClient c
, MonadReader (env c) m
, HasLogFunc (env c)
, HasClient env
, MonadUnliftIO m
, IsVariant a
)
=> ObjectPath
-> (Maybe a -> m ())
:: IsVariant a
=> FilePath
-> ObjectPath
-> (Maybe a -> BTIO ())
-> InterfaceName
-> T.Text
-> m (Maybe SignalHandler)
withBTPropertyRule path update iface prop = do
-> BTIO (Maybe SignalHandler)
withBTPropertyRule logpath path update iface prop = do
dpy <- asks plugDisplay
s <- asks plugState
cb <- asks plugCallback
res <- matchBTProperty path
case res of
Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected)
Just rule -> Just <$> addMatchCallback rule (callback cb s dpy)
Nothing -> do
logError $
"could not add listener for prop "
@ -279,6 +270,10 @@ withBTPropertyRule path update iface prop = do
<> path_
return Nothing
where
callback cb s dpy sig = withDBusClientConnection cb (Just logpath) $ \c' ->
mapRIO (PluginEnv c' s dpy cb) $
signalToUpdate $
matchConnected sig
path_ = displayObjectPath path
prop_ = Utf8Builder $ encodeUtf8Builder prop
signalToUpdate = withSignalMatch update
@ -286,7 +281,7 @@ withBTPropertyRule path update iface prop = do
addAdaptorListener :: ObjectPath -> BTIO (Maybe SignalHandler)
addAdaptorListener adaptor =
withBTPropertyRule adaptor procMatch adapterInterface adaptorPowered
withBTPropertyRule "bluetooth-adaptor" adaptor procMatch adapterInterface adaptorPowered
where
procMatch = beforeDisplay . putPowered
@ -308,7 +303,7 @@ putPowered :: Maybe Bool -> BTIO ()
putPowered ds = modifyState $ \s -> return (s {btPowered = ds}, ())
readPowered :: BTIO (Maybe Bool)
readPowered = fmap btPowered $ readMVar =<< asks btState
readPowered = fmap btPowered $ readMVar =<< asks plugState
adapterInterface :: InterfaceName
adapterInterface = interfaceName_ "org.bluez.Adapter1"
@ -319,9 +314,9 @@ adaptorPowered = "Powered"
--------------------------------------------------------------------------------
-- Devices
addAndInitDevice :: ObjectPath -> BTIO ()
addAndInitDevice device = do
res <- addDeviceListener device
addAndInitDevice :: FilePath -> ObjectPath -> BTIO ()
addAndInitDevice logpath device = do
res <- addDeviceListener logpath device
case res of
Just handler -> do
logInfo $ "initializing device at path " <> device_
@ -340,9 +335,9 @@ initDevice sh device = do
, btDevSigHandler = sh
}
addDeviceListener :: ObjectPath -> BTIO (Maybe SignalHandler)
addDeviceListener device =
withBTPropertyRule device procMatch devInterface devConnected
addDeviceListener :: FilePath -> ObjectPath -> BTIO (Maybe SignalHandler)
addDeviceListener logpath device =
withBTPropertyRule logpath device procMatch devInterface devConnected
where
procMatch = beforeDisplay . void . updateDevice device
@ -378,7 +373,7 @@ removeDevice device = modifyState $ \s -> do
return (s {btDevices = M.delete device devs}, M.lookup device devs)
readDevices :: BTIO ConnectedDevices
readDevices = fmap btDevices $ readMVar =<< asks btState
readDevices = fmap btDevices $ readMVar =<< asks plugState
devInterface :: InterfaceName
devInterface = interfaceName_ "org.bluez.Device1"

View File

@ -12,6 +12,7 @@ module Xmobar.Plugins.Common
, xmobarFGColor
, PluginEnv (..)
, PluginIO
, pluginDisplay
)
where
@ -26,10 +27,17 @@ import XMonad.Hooks.DynamicLog (xmobarColor)
data PluginEnv s c = PluginEnv
{ plugClient :: !c
, plugState :: !(MVar s)
, plugDisplay :: !(PluginIO s c ())
, plugDisplay :: !(Callback -> PluginIO s c ())
, plugCallback :: !Callback
, plugEnv :: !SimpleApp
}
pluginDisplay :: PluginIO s c ()
pluginDisplay = do
cb <- asks plugCallback
dpy <- asks plugDisplay
dpy cb
type PluginIO s c = RIO (PluginEnv s c)
instance HasClient (PluginEnv s) where