xmonad-config/lib/Xmobar/Plugins/Bluetooth.hs

64 lines
1.8 KiB
Haskell
Raw Normal View History

2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Bluetooth plugin
--
-- Use the bluez interface on DBus to check status
module Xmobar.Plugins.Bluetooth
( Bluetooth(..)
, btAlias
2021-11-23 18:28:38 -05:00
, btDep
) where
2020-03-21 01:18:38 -04:00
import Data.Maybe
2021-11-23 18:28:38 -05:00
2020-03-25 18:55:52 -04:00
import DBus
import DBus.Client
2020-03-21 01:18:38 -04: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
import Xmobar.Plugins.Common
2020-03-21 01:18:38 -04:00
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
2020-03-21 01:18:38 -04:00
2021-11-08 00:27:39 -05:00
btInterface :: InterfaceName
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"
btBus :: BusName
btBus = busName_ "org.bluez"
-- TODO this feels like something that shouldn't be hardcoded
btPath :: ObjectPath
btPath = objectPath_ "/org/bluez/hci0"
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
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
alias (Bluetooth _) = btAlias
start (Bluetooth (text, colorOn, colorOff)) cb = do
withDBusClientConnection_ True $ \c -> do
reply <- callGetPowered c
cb $ maybe "N/A" chooseColor' $ fromVariant =<< listToMaybe reply
addMatchCallback (matchProperty btPath) (procMatch cb . matchPowered) c
2020-03-21 01:18:38 -04:00
where
procMatch f (Match on) = f $ chooseColor' on
procMatch f Failure = f "N/A"
procMatch _ NoMatch = return ()
chooseColor' = chooseColor text colorOn colorOff