ENH use depends interface throughout xmobar
This commit is contained in:
parent
23098420aa
commit
3bf1ae55fa
159
bin/xmobar.hs
159
bin/xmobar.hs
|
@ -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
|
||||||
|
return $ Just x
|
||||||
|
_ -> return Nothing
|
||||||
|
|
||||||
getEthernet :: IO (Maybe CmdSpec)
|
vpnPresent :: IO (Maybe Bool)
|
||||||
getEthernet = do
|
vpnPresent = 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 ""
|
res <- tryIOError $ readProcessWithExitCode "nmcli" args ""
|
||||||
case res of
|
-- TODO provide some error messages
|
||||||
(Right (ExitSuccess, out, _)) -> do
|
return $ case res of
|
||||||
e <- pathExists True vpnBus vpnPath
|
(Right (ExitSuccess, out, _)) -> Just $ "vpn" `elem` lines out
|
||||||
return $ toJust vpnCmd (e && "vpn" `elem` lines out)
|
_ -> Nothing
|
||||||
(Left _) -> do
|
|
||||||
putStrLn "WARNING: could not get list of network interfaces"
|
|
||||||
return Nothing
|
|
||||||
_ -> return 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue