diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 2fac7ee..0f3d0af 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -12,6 +12,7 @@ module Main (main) where -- * A custom Locks plugin from my own forked repo import Control.Monad (unless) + import Data.Either import Data.List import Data.Maybe @@ -42,12 +43,9 @@ import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Control -import XMonad.Internal.Shell --- import XMonad.Internal.DBus.Common (xmonadBus) --- import XMonad.Internal.DBus.Control (pathExists) import XMonad.Internal.DBus.Screensaver (ssSignalDep) import XMonad.Internal.Dependency --- import XMonad.Internal.Shell (fmtCmd) +import XMonad.Internal.Shell import qualified XMonad.Internal.Theme as T import Xmobar @@ -223,13 +221,14 @@ dateCmd = CmdSpec -------------------------------------------------------------------------------- -- | command runtime checks and setup - +-- -- some commands depend on the presence of interfaces that can only be -- determined at runtime; define these checks here - +-- -- in the case of network interfaces, assume that the system uses systemd in -- which case ethernet interfaces always start with "en" and wireless -- interfaces always start with "wl" + isWireless :: String -> Bool isWireless ('w':'l':_) = True isWireless _ = False @@ -288,11 +287,12 @@ getWireless = Feature getEthernet :: Maybe Client -> BarFeature getEthernet client = Feature - { ftrDepTree = DBusTree (Double (\i _ -> ethernetCmd i) (readInterface isEthernet)) client [dep] [] + { ftrDepTree = DBusTree action client [dep] [] , ftrName = "ethernet status indicator" , ftrWarning = Default } where + action = Double (\i _ -> ethernetCmd i) (readInterface isEthernet) dep = Endpoint devBus devPath devInterface $ Method_ devGetByIP getBattery :: BarFeature @@ -316,12 +316,10 @@ getVPN client = Feature getBt :: Maybe Client -> BarFeature getBt client = Feature - { ftrDepTree = DBusTree (Single (const btCmd)) client [ep] [] + { ftrDepTree = DBusTree (Single (const btCmd)) client [btDep] [] , ftrName = "bluetooth status indicator" , ftrWarning = Default } - where - ep = Endpoint btBus btPath btInterface $ Property_ btPowered getAlsa :: BarFeature getAlsa = Feature diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs index 57eb954..7960ca9 100644 --- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs +++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs @@ -126,5 +126,5 @@ clevoKeyboardControls = brightnessControls clevoKeyboardConfig callGetBrightnessCK :: Client -> IO (Maybe Brightness) callGetBrightnessCK = callGetBrightness clevoKeyboardConfig -matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler +matchSignalCK :: (Maybe Brightness -> IO ()) -> Client -> IO () matchSignalCK = matchSignal clevoKeyboardConfig diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index bdc334c..8fe815c 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -71,12 +71,9 @@ signalDep :: BrightnessConfig a b -> DBusDep signalDep BrightnessConfig { bcPath = p, bcInterface = i } = Endpoint xmonadBusName p i $ Signal_ memCur -matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler -matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do - client <- connectSession - -- this connections must remain active - -- TODO does this need to be cleaned up during shutdown?? - addMatch client brMatcher $ cb . bodyGetBrightness . signalBody +matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> Client -> IO () +matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = + addMatchCallback brMatcher (cb . bodyGetBrightness) where brMatcher = matchAny { matchPath = Just p diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index 2b855bc..3931cb0 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -108,5 +108,5 @@ intelBacklightControls = brightnessControls intelBacklightConfig callGetBrightnessIB :: Client -> IO (Maybe Brightness) callGetBrightnessIB = callGetBrightness intelBacklightConfig -matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler +matchSignalIB :: (Maybe Brightness -> IO ()) -> Client -> IO () matchSignalIB = matchSignal intelBacklightConfig diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs index 32dec69..a4d5666 100644 --- a/lib/XMonad/Internal/DBus/Common.hs +++ b/lib/XMonad/Internal/DBus/Common.hs @@ -3,9 +3,15 @@ module XMonad.Internal.DBus.Common ( addMatchCallback + , getDBusClient + , withDBusClient + , withDBusClient_ , xmonadBusName ) where +import Control.Exception +import Control.Monad + import DBus import DBus.Client @@ -13,7 +19,25 @@ xmonadBusName :: BusName xmonadBusName = busName_ "org.xmonad" -- | Bind a callback to a signal match rule -addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler -addMatchCallback rule cb = do - client <- connectSession - addMatch client rule $ cb . signalBody +addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> Client -> IO () +addMatchCallback rule cb client = void $ addMatch client rule $ cb . signalBody + +getDBusClient :: Bool -> IO (Maybe Client) +getDBusClient sys = do + res <- try $ if sys then connectSystem else connectSession + case res of + Left e -> putStrLn (clientErrorMessage e) >> return Nothing + Right c -> return $ Just c + +withDBusClient :: Bool -> (Client -> a) -> IO (Maybe a) +withDBusClient sys f = do + client <- getDBusClient sys + let r = f <$> client + mapM_ disconnect client + return r + +withDBusClient_ :: Bool -> (Client -> IO ()) -> IO () +withDBusClient_ sys f = do + client <- getDBusClient sys + mapM_ f client + mapM_ disconnect client diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 907caf2..78730fa 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -7,12 +7,13 @@ module XMonad.Internal.DBus.Control ( Client , startXMonadService , getDBusClient + , withDBusClient + , withDBusClient_ , stopXMonadService , pathExists , disconnect ) where -import Control.Exception import Control.Monad (forM_, void) import Data.Either @@ -46,12 +47,6 @@ stopXMonadService client = do void $ releaseName client xmonadBusName disconnect client -getDBusClient :: Bool -> IO (Maybe Client) -getDBusClient sys = do - res <- try $ if sys then connectSystem else connectSession - case res of - Left e -> putStrLn (clientErrorMessage e) >> return Nothing - Right c -> return $ Just c requestXMonadName :: Client -> IO () requestXMonadName client = do diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 963ff1c..353788e 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -129,7 +129,7 @@ callQuery client = do reply <- callMethod client xmonadBusName ssPath interface memQuery return $ either (const Nothing) bodyGetCurrentState reply -matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler +matchSignal :: (Maybe SSState -> IO ()) -> Client -> IO () matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState ssSignalDep :: DBusDep diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs new file mode 100644 index 0000000..892d7ed --- /dev/null +++ b/lib/Xmobar/Plugins/BacklightCommon.hs @@ -0,0 +1,25 @@ +-------------------------------------------------------------------------------- +-- | Common backlight plugin bits +-- +-- Use the custom DBus interface exported by the XMonad process so I can react +-- to signals spawned by commands + +module Xmobar.Plugins.BacklightCommon (startBacklight) where + +import Control.Concurrent +import Control.Monad + +import DBus.Client + +import XMonad.Internal.DBus.Control + +startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> Client -> IO ()) + -> (Client -> IO (Maybe a)) -> String -> (String -> IO ()) -> IO () +startBacklight matchSignal callGetBrightness icon cb = do + withDBusClient_ False $ \c -> do + matchSignal (cb . formatBrightness) c + cb . formatBrightness =<< callGetBrightness c + forever (threadDelay 5000000) + where + formatBrightness = maybe "N/A" $ + \b -> icon ++ show (round b :: Integer) ++ "%" diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index f762a7d..308a3ee 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -9,24 +9,24 @@ module Xmobar.Plugins.Bluetooth ( Bluetooth(..) , btAlias - , btBus - , btPath - , btPowered - , btInterface + , btDep ) where + import DBus import DBus.Client -import XMonad.Hooks.DynamicLog (xmobarColor) +import XMonad.Hooks.DynamicLog (xmobarColor) +import XMonad.Internal.Dependency import Xmobar data Bluetooth = Bluetooth (String, String, String) Int deriving (Read, Show) -callGetPowered :: Client -> IO (Either MethodError Variant) -callGetPowered client = - getProperty client (methodCall btPath btInterface $ memberName_ btPowered) +-- TODO match property signal here +callGetPowered :: Client -> IO (Maybe Variant) +callGetPowered client = either (const Nothing) Just + <$> getProperty client (methodCall btPath btInterface $ memberName_ btPowered) { methodCallDestination = Just btBus } btInterface :: InterfaceName @@ -47,6 +47,9 @@ btPath = "/org/bluez/hci0" btAlias :: String btAlias = "bluetooth" +btDep :: DBusDep +btDep = Endpoint btBus btPath btInterface $ Property_ btPowered + instance Exec Bluetooth where alias (Bluetooth _ _) = btAlias rate (Bluetooth _ r) = r @@ -54,12 +57,8 @@ instance Exec Bluetooth where client <- connectSystem reply <- callGetPowered client disconnect client - return $ fmtState $ procReply reply + return $ fmtState $ fromVariant =<< reply where - procReply = \case - -- TODO handle errors? - Right r -> fromVariant r - Left _ -> Nothing fmtState = \case Just s -> xmobarColor (if s then colorOn else colorOff) "" text Nothing -> "N/A" diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs index 56ab64a..2cdc1c5 100644 --- a/lib/Xmobar/Plugins/ClevoKeyboard.hs +++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -------------------------------------------------------------------------------- -- | Clevo Keyboard plugin -- @@ -11,13 +9,10 @@ module Xmobar.Plugins.ClevoKeyboard , ckAlias ) where -import Control.Concurrent -import Control.Monad - -import DBus.Client - import Xmobar +import Xmobar.Plugins.BacklightCommon + import XMonad.Internal.DBus.Brightness.ClevoKeyboard newtype ClevoKeyboard = ClevoKeyboard String deriving (Read, Show) @@ -28,12 +23,4 @@ ckAlias = "clevokeyboard" instance Exec ClevoKeyboard where alias (ClevoKeyboard _) = ckAlias start (ClevoKeyboard icon) cb = do - _ <- matchSignalCK $ cb . formatBrightness - -- TODO this could fail, and also should try to reuse client objects when - -- possible - cb . formatBrightness =<< callGetBrightnessCK =<< connectSession - forever (threadDelay 5000000) - where - formatBrightness = \case - Just b -> icon ++ show (round b :: Integer) ++ "%" - Nothing -> "N/A" + startBacklight matchSignalCK callGetBrightnessCK icon cb diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index 750aa7a..7c4efb3 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -------------------------------------------------------------------------------- -- | Intel backlight plugin -- @@ -11,13 +9,10 @@ module Xmobar.Plugins.IntelBacklight , blAlias ) where -import Control.Concurrent -import Control.Monad - -import DBus.Client - import Xmobar +import Xmobar.Plugins.BacklightCommon + import XMonad.Internal.DBus.Brightness.IntelBacklight newtype IntelBacklight = IntelBacklight String deriving (Read, Show) @@ -27,11 +22,5 @@ blAlias = "intelbacklight" instance Exec IntelBacklight where alias (IntelBacklight _) = blAlias - start (IntelBacklight icon) cb = do - _ <- matchSignalIB $ cb . formatBrightness - cb . formatBrightness =<< callGetBrightnessIB =<< connectSession - forever (threadDelay 5000000) - where - formatBrightness = \case - Just b -> icon ++ show (round b :: Integer) ++ "%" - Nothing -> "N/A" + start (IntelBacklight icon) cb = + startBacklight matchSignalIB callGetBrightnessIB icon cb diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 48774e3..4c9bf10 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -14,11 +14,10 @@ module Xmobar.Plugins.Screensaver import Control.Concurrent import Control.Monad -import DBus.Client - import Xmobar import XMonad.Hooks.DynamicLog (xmobarColor) +import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Screensaver newtype Screensaver = Screensaver (String, String, String) deriving (Read, Show) @@ -29,8 +28,9 @@ ssAlias = "screensaver" instance Exec Screensaver where alias (Screensaver _) = ssAlias start (Screensaver (text, colorOn, colorOff)) cb = do - _ <- matchSignal $ cb . fmtState - cb . fmtState =<< callQuery =<< connectSession + withDBusClient_ False $ \c -> do + matchSignal (cb . fmtState) c + cb . fmtState =<< callQuery c forever (threadDelay 5000000) where fmtState = \case diff --git a/my-xmonad.cabal b/my-xmonad.cabal index d0bbaf5..0015084 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -24,6 +24,7 @@ library , XMonad.Internal.DBus.Control , XMonad.Internal.DBus.Screensaver , XMonad.Internal.Process + , Xmobar.Plugins.BacklightCommon , Xmobar.Plugins.Bluetooth , Xmobar.Plugins.ClevoKeyboard , Xmobar.Plugins.Device