ENH use indiv logs for bluetooth devs
This commit is contained in:
parent
700f42d65c
commit
13ddeb3ba7
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue