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

87 lines
2.4 KiB
Haskell
Raw Normal View History

2020-05-28 23:17:17 -04:00
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- Device plugin
2020-05-28 23:17:17 -04:00
--
-- Display different text depending on whether or not the interface has
-- connectivity
2022-07-09 17:08:10 -04:00
module Xmobar.Plugins.Device
2022-12-30 14:58:23 -05:00
( Device (..)
2022-07-09 17:08:10 -04:00
, devDep
2022-12-30 14:58:23 -05:00
)
where
import DBus
import Data.Internal.DBus
2023-01-01 18:33:02 -05:00
import Data.Internal.XIO
2022-12-30 16:59:50 -05:00
import RIO
2022-12-30 14:58:23 -05:00
import qualified RIO.Text as T
import XMonad.Internal.Command.Desktop
import XMonad.Internal.DBus.Common
import Xmobar
import Xmobar.Plugins.Common
2021-11-25 00:12:00 -05:00
newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
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"
devSignal :: T.Text
2021-11-25 00:12:00 -05:00
devSignal = "Ip4Connectivity"
2022-07-09 17:08:10 -04:00
devDep :: DBusDependency_ SysClient
2022-12-30 14:58:23 -05:00
devDep =
Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
Method_ getByIP
2023-01-03 22:18:55 -05:00
getDevice
:: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
=> T.Text
-> m (Maybe ObjectPath)
getDevice iface = bodyToMaybe <$> callMethod' mc
2021-11-25 00:12:00 -05:00
where
2022-12-30 14:58:23 -05:00
mc =
(methodCallBus networkManagerBus nmPath nmInterface getByIP)
{ methodCallBody = [toVariant iface]
}
2021-11-25 00:12:00 -05:00
2023-01-01 19:52:01 -05:00
getDeviceConnected
2023-01-03 22:18:55 -05:00
:: ( SafeClient c
, HasClient env
, MonadReader (env c) m
, HasLogFunc (env c)
, MonadUnliftIO m
)
2023-01-01 19:52:01 -05:00
=> ObjectPath
-> m [Variant]
2022-12-30 14:58:23 -05:00
getDeviceConnected path =
callPropertyGet networkManagerBus path nmDeviceInterface $
memberName_ $
T.unpack 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
alias (Device (iface, _, _)) = T.unpack iface
2023-01-01 22:29:29 -05:00
start (Device (iface, text, colors)) cb =
2023-01-03 22:18:55 -05:00
withDBusClientConnection cb logName $ \(sys :: SysClient) -> withDIO sys $ do
path <- getDevice iface
displayMaybe' cb listener path
2020-05-28 23:17:17 -04:00
where
2023-01-03 23:33:08 -05:00
logName = Just $ T.unpack $ T.concat ["device@", iface, ".log"]
2023-01-03 22:18:55 -05:00
listener path = do
res <- matchPropertyFull networkManagerBus (Just path)
2023-01-01 22:40:28 -05:00
case res of
2023-01-03 22:18:55 -05:00
Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb
2023-01-01 22:40:28 -05:00
Nothing -> logError "could not start listener"
2021-11-27 17:33:02 -05:00
chooseColor' = return . (\s -> colorText colors s text) . (> 1)