From 13ddeb3ba7d84942e5b324740e5544e7bd8e67ab Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 1 Oct 2023 01:02:06 -0400 Subject: [PATCH] ENH use indiv logs for bluetooth devs --- lib/Xmobar/Plugins/ActiveConnection.hs | 15 +++-- lib/Xmobar/Plugins/Bluetooth.hs | 85 ++++++++++++-------------- lib/Xmobar/Plugins/Common.hs | 10 ++- 3 files changed, 58 insertions(+), 52 deletions(-) diff --git a/lib/Xmobar/Plugins/ActiveConnection.hs b/lib/Xmobar/Plugins/ActiveConnection.hs index 61c0c10..3a09dcc 100644 --- a/lib/Xmobar/Plugins/ActiveConnection.hs +++ b/lib/Xmobar/Plugins/ActiveConnection.hs @@ -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 diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index 3f99cff..37f3c76 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -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" diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index d6c69f8..3b47bc9 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -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