WIP add bluetooth indicator to xmobar
This commit is contained in:
parent
c96bcc0bfa
commit
ce02bf185f
|
@ -1,3 +1,4 @@
|
||||||
|
import Xmobar.Plugins.Bluetooth
|
||||||
import Xmobar.Plugins.IntelBacklight
|
import Xmobar.Plugins.IntelBacklight
|
||||||
import Xmobar.Plugins.Screensaver
|
import Xmobar.Plugins.Screensaver
|
||||||
|
|
||||||
|
@ -26,6 +27,7 @@ myTemplate = formatTemplate left right
|
||||||
, "%alsa:default:Master%"
|
, "%alsa:default:Master%"
|
||||||
, "%battery%"
|
, "%battery%"
|
||||||
, "%intelbacklight%"
|
, "%intelbacklight%"
|
||||||
|
, "%bluetooth%"
|
||||||
, "%screensaver%"
|
, "%screensaver%"
|
||||||
, "%locks%"
|
, "%locks%"
|
||||||
, "%date%"
|
, "%date%"
|
||||||
|
@ -121,6 +123,8 @@ config confDir = defaultConfig
|
||||||
|
|
||||||
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
|
, Run $ Screensaver ("<fn=1>\xf254</fn>", T.fgColor, T.backdropFgColor)
|
||||||
|
|
||||||
|
, Run $ Bluetooth ("BT", T.fgColor, T.backdropFgColor)
|
||||||
|
|
||||||
, Run UnsafeStdinReader
|
, Run UnsafeStdinReader
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
{-# 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>"
|
|
@ -14,8 +14,9 @@ library
|
||||||
, DBus.IntelBacklight
|
, DBus.IntelBacklight
|
||||||
, DBus.Internal
|
, DBus.Internal
|
||||||
, DBus.Screensaver
|
, DBus.Screensaver
|
||||||
, Xmobar.Plugins.Screensaver
|
, Xmobar.Plugins.Bluetooth
|
||||||
, Xmobar.Plugins.IntelBacklight
|
, Xmobar.Plugins.IntelBacklight
|
||||||
|
, Xmobar.Plugins.Screensaver
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, X11 >= 1.9.1
|
, X11 >= 1.9.1
|
||||||
, colour >= 2.3.5
|
, colour >= 2.3.5
|
||||||
|
|
Loading…
Reference in New Issue