90 lines
2.5 KiB
Haskell
90 lines
2.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Device plugin
|
|
--
|
|
-- Display different text depending on whether or not the interface has
|
|
-- connectivity
|
|
|
|
module Xmobar.Plugins.Device
|
|
( Device (..)
|
|
, devDep
|
|
)
|
|
where
|
|
|
|
import DBus
|
|
import Data.Internal.DBus
|
|
import Data.Internal.XIO
|
|
import RIO
|
|
import qualified RIO.Text as T
|
|
import XMonad.Internal.Command.Desktop
|
|
import XMonad.Internal.DBus.Common
|
|
import Xmobar
|
|
import Xmobar.Plugins.Common
|
|
|
|
newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
|
|
|
|
nmPath :: ObjectPath
|
|
nmPath = objectPath_ "/org/freedesktop/NetworkManager"
|
|
|
|
nmInterface :: InterfaceName
|
|
nmInterface = interfaceName_ "org.freedesktop.NetworkManager"
|
|
|
|
nmDeviceInterface :: InterfaceName
|
|
nmDeviceInterface = interfaceName_ "org.freedesktop.NetworkManager.Device"
|
|
|
|
getByIP :: MemberName
|
|
getByIP = memberName_ "GetDeviceByIpIface"
|
|
|
|
devSignal :: T.Text
|
|
devSignal = "Ip4Connectivity"
|
|
|
|
devDep :: DBusDependency_ SysClient
|
|
devDep =
|
|
Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
|
|
Method_ getByIP
|
|
|
|
getDevice
|
|
:: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
|
|
=> T.Text
|
|
-> m (Maybe ObjectPath)
|
|
getDevice iface = bodyToMaybe <$> callMethod' mc
|
|
where
|
|
mc =
|
|
(methodCallBus networkManagerBus nmPath nmInterface getByIP)
|
|
{ methodCallBody = [toVariant iface]
|
|
}
|
|
|
|
getDeviceConnected
|
|
:: ( SafeClient c
|
|
, HasClient env
|
|
, MonadReader (env c) m
|
|
, HasLogFunc (env c)
|
|
, MonadUnliftIO m
|
|
)
|
|
=> ObjectPath
|
|
-> m [Variant]
|
|
getDeviceConnected path =
|
|
callPropertyGet networkManagerBus path nmDeviceInterface $
|
|
memberName_ $
|
|
T.unpack devSignal
|
|
|
|
matchStatus :: [Variant] -> SignalMatch Word32
|
|
matchStatus = matchPropertyChanged nmDeviceInterface devSignal
|
|
|
|
instance Exec Device where
|
|
alias (Device (iface, _, _)) = T.unpack iface
|
|
start (Device (iface, text, colors)) cb =
|
|
withDBusClientConnection cb logName $ \(sys :: SysClient) -> withDIO sys $ do
|
|
path <- getDevice iface
|
|
displayMaybe' cb listener path
|
|
where
|
|
logName = "device@" <> Utf8Builder (encodeUtf8Builder iface)
|
|
listener path = do
|
|
res <- matchPropertyFull networkManagerBus (Just path)
|
|
case res of
|
|
Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb
|
|
Nothing -> logError "could not start listener"
|
|
chooseColor' = return . (\s -> colorText colors s text) . (> 1)
|