ENH make xmobar dump features

This commit is contained in:
Nathan Dwarshuis 2022-08-01 16:16:08 -04:00
parent 74f70df2cd
commit 83d4873c10
1 changed files with 33 additions and 6 deletions

View File

@ -16,6 +16,7 @@ import Data.Internal.Dependency
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import System.Environment
import System.Exit import System.Exit
import System.IO import System.IO
import System.IO.Error import System.IO.Error
@ -40,11 +41,21 @@ import XMonad.Internal.Process hiding (CmdSpec)
import qualified XMonad.Internal.Theme as T import qualified XMonad.Internal.Theme as T
import Xmobar hiding import Xmobar hiding
( iconOffset ( iconOffset
, run
) )
import Xmobar.Plugins.Common import Xmobar.Plugins.Common
main :: IO () main :: IO ()
main = do main = getArgs >>= parse
parse :: [String] -> IO ()
parse [] = run
parse ["--deps"] = withCache printDeps
parse _ = usage
run :: IO ()
run = do
db <- connectDBus db <- connectDBus
c <- withCache $ evalConfig db c <- withCache $ evalConfig db
disconnectDBus db disconnectDBus db
@ -63,6 +74,20 @@ evalConfig db = do
d <- io $ cfgDir <$> getDirectories d <- io $ cfgDir <$> getDirectories
return $ config bf ifs ios cs d return $ config bf ifs ios cs d
printDeps :: FIO ()
printDeps = do
db <- io connectDBus
fs <- mapM dumpFeature $ allFeatures db
let (UQ u) = jsonArray $ fmap JSON_UQ fs
io $ putStrLn u
io $ disconnectDBus db
usage :: IO ()
usage = putStrLn $ intercalate "\n"
[ "xmobar: run greatest taskbar"
, "xmobar --deps: print dependencies"
]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | toplevel configuration -- | toplevel configuration
@ -151,8 +176,13 @@ getAllCommands right = BarRegions
} }
rightPlugins :: DBusState -> FIO [Maybe CmdSpec] rightPlugins :: DBusState -> FIO [Maybe CmdSpec]
rightPlugins DBusState { dbSesClient = ses, dbSysClient = sys } rightPlugins db = mapM evalFeature $ allFeatures db
= mapM evalFeature ++ [always' "date indicator" dateCmd]
where
always' n = Right . Always n . Always_ . FallbackAlone
allFeatures :: DBusState -> [Feature CmdSpec]
allFeatures DBusState { dbSesClient = ses, dbSysClient = sys } =
[ Left getWireless [ Left getWireless
, Left $ getEthernet sys , Left $ getEthernet sys
, Left $ getVPN sys , Left $ getVPN sys
@ -163,10 +193,7 @@ rightPlugins DBusState { dbSesClient = ses, dbSysClient = sys }
, Left $ getCk ses , Left $ getCk ses
, Left $ getSs ses , Left $ getSs ses
, Right getLock , Right getLock
, always' "date indicator" dateCmd
] ]
where
always' n = Right . Always n . Always_ . FallbackAlone
type BarFeature = Sometimes CmdSpec type BarFeature = Sometimes CmdSpec