50 lines
1.5 KiB
Haskell
50 lines
1.5 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Xmobar.Plugins.Bluetooth where
|
|
|
|
import Control.Concurrent
|
|
import Control.Monad
|
|
|
|
import Data.List (find)
|
|
import Data.Maybe (mapMaybe)
|
|
|
|
import DBus
|
|
import DBus.Client
|
|
|
|
import Xmobar
|
|
|
|
newtype Bluetooth = Bluetooth (String, String, String) deriving (Read, Show)
|
|
|
|
rule :: MatchRule
|
|
rule = matchAny
|
|
{ matchPath = Just "/org/bluez/hci0"
|
|
, matchInterface = Just "org.freedesktop.DBus.Properties"
|
|
, matchMember = Just "PropertiesChanged"
|
|
}
|
|
|
|
instance Exec Bluetooth where
|
|
alias (Bluetooth _) = "bluetooth"
|
|
start (Bluetooth (text, colorOn, colorOff)) cb = do
|
|
client <- connectSystem
|
|
_ <- addMatch client rule $ cb . fmtState . stateFromSignal
|
|
-- TODO initialize here
|
|
-- cb . formatBrightness =<< callGetBrightness
|
|
forever (threadDelay 5000)
|
|
where
|
|
-- TODO this is total utter garbage...but it works...
|
|
stateFromSignal sig = join
|
|
$ fmap (fromVariant :: (Variant -> Maybe Bool))
|
|
$ join
|
|
$ fmap (fromVariant :: (Variant -> Maybe Variant))
|
|
$ fmap snd
|
|
$ find (\(k, _) -> (fromVariant k :: Maybe String) == Just "Powered")
|
|
$ concatMap dictionaryItems
|
|
$ mapMaybe fromVariant
|
|
$ filter (\v -> variantType v == TypeDictionary TypeString TypeVariant)
|
|
$ signalBody sig
|
|
fmtState = \case
|
|
Just s -> wrapColor text $ if s then colorOn else colorOff
|
|
Nothing -> "N/A"
|
|
wrapColor s c = "<fc=" ++ c ++ ">" ++ s ++ "</fc>"
|