ENH use indiv logs for bluetooth devs

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)
+      let mapEnv c' = mapRIO (PluginEnv c' s dpy cb)
-      mapEnv c $ addListener mapEnv >> dpy
+      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 (2 :: Word32) -> updateConnected contypes path >> pluginDisplay
-      Just 4 -> updateDisconnected path >> dpy
+      Just 4 -> updateDisconnected path >> pluginDisplay
       _ -> return ()
     _ -> return ()
   where

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)
+  let dpy cb' = displayIcon cb' (iconFormatter is cs)
-  mapRIO (BTEnv cl state dpy) $ do
+  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
+        pluginDisplay
-        -- keep file descriptors open in callback threads
+
-        forever $ threadDelay 1000000
+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
+type BTIO = PluginIO BtState SysClient
-  { 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)
 
 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
+  :: IsVariant a
-     , MonadReader (env c) m
+  => FilePath
-     , HasLogFunc (env c)
+  -> ObjectPath
-     , HasClient env
+  -> (Maybe a -> BTIO ())
-     , MonadUnliftIO m
-     , IsVariant a
-     )
-  => ObjectPath
-  -> (Maybe a -> m ())
   -> InterfaceName
   -> T.Text
-  -> m (Maybe SignalHandler)
+  -> BTIO (Maybe SignalHandler)
-withBTPropertyRule path update iface prop = do
+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 :: FilePath -> ObjectPath -> BTIO ()
-addAndInitDevice device = do
+addAndInitDevice logpath device = do
-  res <- addDeviceListener device
+  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 :: FilePath -> ObjectPath -> BTIO (Maybe SignalHandler)
-addDeviceListener device =
+addDeviceListener logpath device =
-  withBTPropertyRule device procMatch devInterface devConnected
+  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"

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