ENH use depends interface throughout xmobar

This commit is contained in:
Nathan Dwarshuis 2021-11-09 00:59:17 -05:00
parent 23098420aa
commit 3bf1ae55fa
5 changed files with 126 additions and 81 deletions

View File

@ -11,6 +11,7 @@ module Main (main) where
-- * Theme integration with xmonad (shared module imported below) -- * Theme integration with xmonad (shared module imported below)
-- * A custom Locks plugin from my own forked repo -- * A custom Locks plugin from my own forked repo
import Control.Monad (unless)
import Data.Either import Data.Either
import Data.List import Data.List
import Data.Maybe import Data.Maybe
@ -38,10 +39,13 @@ import XMonad.Hooks.DynamicLog
, xmobarColor , xmobarColor
) )
import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.IntelBacklight (blPath) import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common (xmonadBus) ( curFileDep
import XMonad.Internal.DBus.Control (pathExists) , maxFileDep
import XMonad.Internal.DBus.Screensaver (ssPath) )
-- import XMonad.Internal.DBus.Common (xmonadBus)
-- import XMonad.Internal.DBus.Control (pathExists)
import XMonad.Internal.DBus.Screensaver (ssDep)
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
-- import XMonad.Internal.Shell (fmtCmd) -- import XMonad.Internal.Shell (fmtCmd)
import qualified XMonad.Internal.Theme as T import qualified XMonad.Internal.Theme as T
@ -49,8 +53,12 @@ import Xmobar
main :: IO () main :: IO ()
main = do main = do
cs <- getAllCommands rs <- sequence rightPlugins
warnMissing rs
cs <- getAllCommands rs
d <- getXMonadDir d <- getXMonadDir
-- this is needed to see any printed messages
hFlush stdout
xmobar $ config cs d xmobar $ config cs d
config :: BarRegions -> String -> Config config :: BarRegions -> String -> Config
@ -218,14 +226,11 @@ dateCmd = CmdSpec
-- some commands depend on the presence of interfaces that can only be -- some commands depend on the presence of interfaces that can only be
-- determined at runtime; define these checks here -- determined at runtime; define these checks here
noSetup :: Monad m => a -> m (Maybe a) -- noSetup :: Monad m => a -> m (Maybe a)
noSetup = return . Just -- noSetup = return . Just
toJust :: a -> Bool -> Maybe a -- toJust :: a -> Bool -> Maybe a
toJust x b = if b then Just x else Nothing -- toJust x b = if b then Just x else Nothing
whenDBusPath :: Bool -> BusName -> ObjectPath -> CmdSpec -> IO (Maybe CmdSpec)
whenDBusPath usesys b p cs = toJust cs <$> pathExists usesys b p
dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency
dbusDep usesys bus obj iface mem = dbusDep usesys bus obj iface mem =
@ -239,7 +244,6 @@ dbusDep usesys bus obj iface mem =
, ddDbusMember = mem , ddDbusMember = mem
} }
-- in the case of network interfaces, assume that the system uses systemd in -- in the case of network interfaces, assume that the system uses systemd in
-- which case ethernet interfaces always start with "en" and wireless -- which case ethernet interfaces always start with "en" and wireless
-- interfaces always start with "wl" -- interfaces always start with "wl"
@ -257,86 +261,101 @@ listInterfaces = fromRight [] <$> tryIOError (listDirectory sysfsNet)
sysfsNet :: FilePath sysfsNet :: FilePath
sysfsNet = "/sys/class/net" sysfsNet = "/sys/class/net"
getWireless :: IO (Maybe CmdSpec) readInterface :: (String -> Bool) -> IO (Maybe String)
getWireless = do readInterface f = do
ns <- filter isWireless <$> listInterfaces ns <- filter f <$> listInterfaces
return $ case ns of case ns of
[n] -> Just $ wirelessCmd n (x:xs) -> do
_ -> Nothing unless (null xs) $
putStrLn $ "WARNING: extra interfaces found, using " ++ x
getEthernet :: IO (Maybe CmdSpec) return $ Just x
getEthernet = do
e <- pathExists True devBus devPath
ns <- filter isEthernet <$> listInterfaces
return $ case ns of
[n] -> toJust (ethernetCmd n) e
_ -> Nothing
getBattery :: IO (Maybe CmdSpec)
getBattery = toJust batteryCmd <$> hasBattery
getVPN :: IO (Maybe CmdSpec)
getVPN = do
res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
case res of
(Right (ExitSuccess, out, _)) -> do
e <- pathExists True vpnBus vpnPath
return $ toJust vpnCmd (e && "vpn" `elem` lines out)
(Left _) -> do
putStrLn "WARNING: could not get list of network interfaces"
return Nothing
_ -> return Nothing _ -> return Nothing
vpnPresent :: IO (Maybe Bool)
vpnPresent = do
res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
-- TODO provide some error messages
return $ case res of
(Right (ExitSuccess, out, _)) -> Just $ "vpn" `elem` lines out
_ -> Nothing
where where
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"] args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
rightPlugins :: [IO (MaybeExe CmdSpec)]
rightPlugins =
[ getWireless
, getEthernet
, getVPN
, getBt
, getAlsa
, getBattery
, getBl
, nocheck ckCmd
, getSs
, nocheck lockCmd
, nocheck dateCmd
]
where
nocheck = return . flip Installed []
getWireless :: IO (MaybeExe CmdSpec)
getWireless = do
i <- readInterface isWireless
return $ maybe Ignore (flip Installed [] . wirelessCmd) i
getEthernet :: IO (MaybeExe CmdSpec)
getEthernet = do
i <- readInterface isEthernet
maybe (return Ignore) (runIfInstalled [dep] . ethernetCmd) i
where
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
getBattery :: IO (MaybeExe CmdSpec)
getBattery = go <$> hasBattery
where
-- TODO refactor this pattern
go True = Installed batteryCmd []
go False = Ignore
getVPN :: IO (MaybeExe CmdSpec)
getVPN = do
v <- vpnPresent
case v of
(Just True) -> runIfInstalled [dep] vpnCmd
_ -> return Ignore
where
dep = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
getBt :: IO (MaybeExe CmdSpec) getBt :: IO (MaybeExe CmdSpec)
-- getBt = whenDBusPath True btBus btPath btCmd
getBt = runIfInstalled [dep] btCmd getBt = runIfInstalled [dep] btCmd
where where
dep = dbusDep True btBus btPath btInterface $ Property_ btPowered dep = dbusDep True btBus btPath btInterface $ Property_ btPowered
getAlsa :: IO (Maybe CmdSpec) getAlsa :: IO (MaybeExe CmdSpec)
getAlsa = toJust alsaCmd . isJust <$> findExecutable "alsactl" getAlsa = runIfInstalled [exe "alsactl"] alsaCmd
getBl :: IO (Maybe CmdSpec) getBl :: IO (MaybeExe CmdSpec)
getBl = whenDBusPath False xmonadBus blPath blCmd getBl = runIfInstalled [curFileDep, maxFileDep] blCmd
getSs :: IO (Maybe CmdSpec) getSs :: IO (MaybeExe CmdSpec)
getSs = whenDBusPath False xmonadBus ssPath ssCmd getSs = runIfInstalled [ssDep] ssCmd
getAllCommands :: IO BarRegions getAllCommands :: [MaybeExe CmdSpec] -> IO BarRegions
getAllCommands = do getAllCommands right = do
getBt' <- getBt
let bt = case getBt' of
(Installed x _) -> Just x
_ -> Nothing
let left = let left =
[ CmdSpec [ CmdSpec
{ csAlias = "UnsafeStdinReader" { csAlias = "UnsafeStdinReader"
, csRunnable = Run UnsafeStdinReader , csRunnable = Run UnsafeStdinReader
} }
] ]
right <- catMaybes <$> sequence
[ getWireless
, getEthernet
, getVPN
-- , getBt
, return bt
, getAlsa
, getBattery
, getBl
, noSetup ckCmd
, getSs
, noSetup lockCmd
, noSetup dateCmd
]
-- this is needed to see any printed messages
hFlush stdout
return $ BarRegions return $ BarRegions
{ brLeft = left { brLeft = left
, brCenter = [] , brCenter = []
, brRight = right , brRight = mapMaybe eval right
} }
where
eval (Installed x _) = Just x
eval _ = Nothing
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | various formatting things -- | various formatting things

View File

@ -5,11 +5,11 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
( callGetBrightnessIB ( callGetBrightnessIB
, matchSignalIB , matchSignalIB
, exportIntelBacklight , exportIntelBacklight
-- , hasBacklight , curFileDep
, maxFileDep
, blPath , blPath
) where ) where
-- import Data.Either
import Data.Int (Int32) import Data.Int (Int32)
import DBus import DBus
@ -113,10 +113,15 @@ intelBacklightConfig = BrightnessConfig
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported haskell API -- | Exported haskell API
curFileDep :: Dependency
curFileDep = pathRW curFile
maxFileDep :: Dependency
maxFileDep = pathR maxFile
exportIntelBacklight :: Client -> IO BrightnessControls exportIntelBacklight :: Client -> IO BrightnessControls
exportIntelBacklight = exportBrightnessControls deps intelBacklightConfig exportIntelBacklight =
where exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig
deps = [pathRW curFile, pathR maxFile]
-- b <- hasBacklightMsg -- b <- hasBacklightMsg
-- if b -- if b
-- then Just <$> exportBrightnessControls intelBacklightConfig client -- then Just <$> exportBrightnessControls intelBacklightConfig client

View File

@ -7,6 +7,7 @@ module XMonad.Internal.DBus.Screensaver
, callQuery , callQuery
, matchSignal , matchSignal
, ssPath , ssPath
, ssDep
, SSControls(..) , SSControls(..)
) where ) where
@ -27,11 +28,17 @@ import XMonad.Internal.Process
type SSState = Bool -- true is enabled type SSState = Bool -- true is enabled
ssExecutable :: String
ssExecutable = "xset"
ssDep :: Dependency
ssDep = exe ssExecutable
toggle :: IO SSState toggle :: IO SSState
toggle = do toggle = do
st <- query st <- query
-- TODO figure out how not to do this with shell commands -- TODO figure out how not to do this with shell commands
void $ createProcess' $ proc "xset" $ "s" : args st void $ createProcess' $ proc ssExecutable $ "s" : args st
-- TODO this assumes the command succeeds -- TODO this assumes the command succeeds
return $ not st return $ not st
where where
@ -94,7 +101,7 @@ newtype SSControls = SSControls { ssToggle :: MaybeExe (IO ()) }
exportScreensaver :: Client -> IO SSControls exportScreensaver :: Client -> IO SSControls
exportScreensaver client = do exportScreensaver client = do
(req, opt) <- checkInstalled [exe "xset"] (req, opt) <- checkInstalled [ssDep]
when (null req) $ when (null req) $
exportScreensaver' client exportScreensaver' client
return $ SSControls { ssToggle = createInstalled req opt callToggle } return $ SSControls { ssToggle = createInstalled req opt callToggle }

View File

@ -4,6 +4,8 @@ module Xmobar.Plugins.Device
( Device(..) ( Device(..)
, devBus , devBus
, devPath , devPath
, devInterface
, devGetByIP
) where ) where
-- TOOD this name can be more general -- TOOD this name can be more general
@ -33,10 +35,15 @@ devBus = "org.freedesktop.NetworkManager"
devPath :: ObjectPath devPath :: ObjectPath
devPath = "/org/freedesktop/NetworkManager" devPath = "/org/freedesktop/NetworkManager"
devInterface :: InterfaceName
devInterface = "org.freedesktop.NetworkManager"
devGetByIP :: MemberName
devGetByIP = "GetDeviceByIpIface"
getDevice :: Client -> String -> IO (Maybe ObjectPath) getDevice :: Client -> String -> IO (Maybe ObjectPath)
getDevice client iface = do getDevice client iface = do
let mc = methodCall devPath let mc = methodCall devPath devInterface devGetByIP
"org.freedesktop.NetworkManager" "GetDeviceByIpIface"
reply <- call client $ mc { methodCallBody = [toVariant iface] reply <- call client $ mc { methodCallBody = [toVariant iface]
, methodCallDestination = Just devBus , methodCallDestination = Just devBus
} }

View File

@ -11,6 +11,8 @@ module Xmobar.Plugins.VPN
, vpnAlias , vpnAlias
, vpnBus , vpnBus
, vpnPath , vpnPath
, vpnInterface
, vpnConnType
) where ) where
import DBus import DBus
@ -24,8 +26,7 @@ data VPN = VPN (String, String, String) Int
callConnectionType :: Client -> IO (Either MethodError Variant) callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client = callConnectionType client =
getProperty client (methodCall vpnPath getProperty client (methodCall vpnPath vpnInterface $ memberName_ vpnConnType)
"org.freedesktop.NetworkManager" "PrimaryConnectionType")
{ methodCallDestination = Just vpnBus } { methodCallDestination = Just vpnBus }
vpnBus :: BusName vpnBus :: BusName
@ -34,6 +35,12 @@ vpnBus = "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath vpnPath :: ObjectPath
vpnPath = "/org/freedesktop/NetworkManager" vpnPath = "/org/freedesktop/NetworkManager"
vpnInterface :: InterfaceName
vpnInterface = "org.freedesktop.NetworkManager"
vpnConnType :: String
vpnConnType = "PrimaryConnectionType"
vpnAlias :: String vpnAlias :: String
vpnAlias = "vpn" vpnAlias = "vpn"