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

74 lines
2.2 KiB
Haskell
Raw Normal View History

module Xmobar.Plugins.Device
( Device(..)
2021-11-25 00:12:00 -05:00
, devDep
) where
2020-05-28 23:17:17 -04:00
--------------------------------------------------------------------------------
2021-11-25 00:12:00 -05:00
-- | Devince plugin
2020-05-28 23:17:17 -04:00
--
-- Display different text depending on whether or not the interface has
-- connectivity
import Control.Monad
import Data.Word
import DBus
import DBus.Client
import DBus.Internal
2020-05-28 23:17:17 -04:00
2021-11-25 00:12:00 -05:00
import XMonad.Internal.Dependency
2021-06-19 00:54:01 -04:00
import Xmobar
2021-11-25 00:12:00 -05:00
import Xmobar.Plugins.Common
2021-11-27 17:33:02 -05:00
newtype Device = Device (String, String, Colors) deriving (Read, Show)
2021-11-25 00:12:00 -05:00
nmBus :: BusName
nmBus = busName_ "org.freedesktop.NetworkManager"
2020-05-28 23:17:17 -04:00
2021-11-25 00:12:00 -05:00
nmPath :: ObjectPath
nmPath = objectPath_ "/org/freedesktop/NetworkManager"
2020-05-28 23:17:17 -04:00
2021-11-25 00:12:00 -05:00
nmInterface :: InterfaceName
nmInterface = interfaceName_ "org.freedesktop.NetworkManager"
2021-11-25 00:12:00 -05:00
nmDeviceInterface :: InterfaceName
nmDeviceInterface = interfaceName_ "org.freedesktop.NetworkManager.Device"
2020-05-28 23:17:17 -04:00
2021-11-25 00:12:00 -05:00
getByIP :: MemberName
getByIP = memberName_ "GetDeviceByIpIface"
2021-11-25 00:12:00 -05:00
devSignal :: String
devSignal = "Ip4Connectivity"
devDep :: DBusDependency_
2021-11-25 00:12:00 -05:00
devDep = Endpoint nmBus nmPath nmInterface $ Method_ getByIP
2020-05-28 23:17:17 -04:00
getDevice :: Client -> String -> IO (Maybe ObjectPath)
2021-11-27 13:24:13 -05:00
getDevice client iface = bodyToMaybe <$> callMethod' client mc
2021-11-25 00:12:00 -05:00
where
2021-11-27 13:24:13 -05:00
mc = (methodCallBus nmBus nmPath nmInterface getByIP)
2021-11-25 00:12:00 -05:00
{ methodCallBody = [toVariant iface]
}
getDeviceConnected :: ObjectPath -> Client -> IO [Variant]
2021-11-27 13:24:13 -05:00
getDeviceConnected path = callPropertyGet nmBus path nmDeviceInterface
$ memberName_ devSignal
2021-11-25 00:12:00 -05:00
matchStatus :: [Variant] -> SignalMatch Word32
matchStatus = matchPropertyChanged nmDeviceInterface devSignal
2020-05-28 23:17:17 -04:00
instance Exec Device where
2021-11-27 17:33:02 -05:00
alias (Device (iface, _, _)) = iface
start (Device (iface, text, colors)) cb = do
2021-11-27 13:24:13 -05:00
withDBusClientConnection True cb $ \client -> do
path <- getDevice client iface
displayMaybe' cb (listener client) path
2020-05-28 23:17:17 -04:00
where
2021-11-27 13:24:13 -05:00
listener client path = do
rule <- matchPropertyFull client nmBus (Just path)
-- TODO warn the user here rather than silently drop the listener
forM_ rule $ \r ->
startListener r (getDeviceConnected path) matchStatus chooseColor' cb client
2021-11-27 17:33:02 -05:00
chooseColor' = return . (\s -> colorText colors s text) . (> 1)