2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Bluetooth plugin
|
|
|
|
--
|
|
|
|
-- Use the bluez interface on DBus to check status
|
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
module Xmobar.Plugins.Bluetooth
|
|
|
|
( Bluetooth(..)
|
|
|
|
, btAlias
|
2021-11-23 18:28:38 -05:00
|
|
|
, btDep
|
2021-06-21 23:41:57 -04:00
|
|
|
) where
|
2020-03-21 01:18:38 -04:00
|
|
|
|
2020-03-25 18:55:52 -04:00
|
|
|
import DBus
|
|
|
|
import DBus.Client
|
2020-03-21 01:18:38 -04:00
|
|
|
|
2021-11-24 00:21:18 -05:00
|
|
|
import XMonad.Internal.DBus.Common
|
2021-11-23 18:28:38 -05:00
|
|
|
import XMonad.Internal.Dependency
|
2021-06-19 00:54:01 -04:00
|
|
|
import Xmobar
|
2021-11-24 00:43:58 -05:00
|
|
|
import Xmobar.Plugins.Common
|
2020-03-21 01:18:38 -04:00
|
|
|
|
2021-11-24 00:21:18 -05:00
|
|
|
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
|
2020-03-21 01:18:38 -04:00
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
|
2021-11-08 00:27:39 -05:00
|
|
|
btInterface :: InterfaceName
|
2021-11-24 00:21:18 -05:00
|
|
|
btInterface = interfaceName_ "org.bluez.Adapter1"
|
2021-11-08 00:27:39 -05:00
|
|
|
|
|
|
|
-- weird that this is a string when introspecting but a member name when calling
|
|
|
|
-- a method, not sure if it is supposed to work like that
|
|
|
|
btPowered :: String
|
|
|
|
btPowered = "Powered"
|
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
btBus :: BusName
|
2021-11-24 00:21:18 -05:00
|
|
|
btBus = busName_ "org.bluez"
|
2021-06-21 23:41:57 -04:00
|
|
|
|
|
|
|
-- TODO this feels like something that shouldn't be hardcoded
|
|
|
|
btPath :: ObjectPath
|
2021-11-24 00:21:18 -05:00
|
|
|
btPath = objectPath_ "/org/bluez/hci0"
|
2021-06-21 23:41:57 -04:00
|
|
|
|
|
|
|
btAlias :: String
|
|
|
|
btAlias = "bluetooth"
|
2020-03-21 14:30:27 -04:00
|
|
|
|
2021-11-23 18:28:38 -05:00
|
|
|
btDep :: DBusDep
|
|
|
|
btDep = Endpoint btBus btPath btInterface $ Property_ btPowered
|
|
|
|
|
2021-11-24 00:21:18 -05:00
|
|
|
matchPowered :: [Variant] -> SignalMatch Bool
|
|
|
|
matchPowered = matchPropertyChanged btInterface btPowered fromVariant
|
|
|
|
|
|
|
|
callGetPowered :: Client -> IO [Variant]
|
|
|
|
callGetPowered = callPropertyGet btBus btPath btInterface btPowered
|
|
|
|
|
2020-03-21 01:18:38 -04:00
|
|
|
instance Exec Bluetooth where
|
2021-11-24 00:21:18 -05:00
|
|
|
alias (Bluetooth _) = btAlias
|
|
|
|
start (Bluetooth (text, colorOn, colorOff)) cb = do
|
|
|
|
withDBusClientConnection_ True $ \c -> do
|
2021-11-25 00:12:00 -05:00
|
|
|
startListener rule callGetPowered matchPowered chooseColor' cb c
|
2020-03-21 01:18:38 -04:00
|
|
|
where
|
2021-11-25 00:12:00 -05:00
|
|
|
rule = matchProperty btPath
|
2021-11-24 00:43:58 -05:00
|
|
|
chooseColor' = chooseColor text colorOn colorOff
|
2021-11-25 00:12:00 -05:00
|
|
|
|