ENH add CLI thingy to print dependencies (kinda)

This commit is contained in:
Nathan Dwarshuis 2022-06-14 23:46:24 -04:00
parent 29c58aec7a
commit d767dc7bc0
2 changed files with 63 additions and 24 deletions

View File

@ -14,7 +14,8 @@ import Control.Monad
) )
import Data.List import Data.List
( isPrefixOf ( intercalate
, isPrefixOf
, sortBy , sortBy
, sortOn , sortOn
) )
@ -28,6 +29,7 @@ import Graphics.X11.Types
import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import System.Environment
import System.IO import System.IO
import System.Process import System.Process
@ -75,22 +77,27 @@ import XMonad.Util.NamedActions
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
main :: IO () main :: IO ()
main = do main = getArgs >>= parse
sesClient <- startXMonadService
sysClient <- getDBusClient True parse :: [String] -> IO ()
parse [] = run
parse ["--deps"] = printDeps
parse _ = usage
run :: IO ()
run = do
db <- connectDBus
(h, p) <- spawnPipe "xmobar" (h, p) <- spawnPipe "xmobar"
executeFeature_ $ runRemovableMon sysClient executeFeature_ $ runRemovableMon $ dbSystemClient db
executeFeatureWith_ forkIO_ runPowermon executeFeatureWith_ forkIO_ runPowermon
forkIO_ $ runWorkspaceMon allDWs forkIO_ $ runWorkspaceMon allDWs
let ts = ThreadState let ts = ThreadState
{ tsSessionClient = sesClient { tsChildPIDs = [p]
, tsSystemClient = sysClient
, tsChildPIDs = [p]
, tsChildHandles = [h] , tsChildHandles = [h]
} }
lockRes <- evalFeature runScreenLock lockRes <- evalFeature runScreenLock
let lock = whenSatisfied lockRes let lock = whenSatisfied lockRes
ext <- evalExternal $ externalBindings ts lock ext <- evalExternal $ externalBindings ts db lock
-- IDK why this is necessary; nothing prior to this line will print if missing -- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout hFlush stdout
ds <- getDirectories ds <- getDirectories
@ -114,22 +121,54 @@ main = do
where where
forkIO_ = void . forkIO forkIO_ = void . forkIO
printDeps :: IO ()
printDeps = do
db <- connectDBus
lockRes <- evalFeature runScreenLock
let lock = whenSatisfied lockRes
mapM_ printDep $ concatMap flatten $ externalBindings ts db lock
where
ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
flatten = concatMap (dtDeps . ftrDepTree . kbMaybeAction) . kgBindings
dtDeps (GenTree _ ds) = ds
dtDeps (DBusTree _ _ _ ds) = ds
printDep (Executable s) = putStrLn s
printDep _ = skip
usage :: IO ()
usage = putStrLn $ intercalate "\n"
[ "xmonad: run greatest window manager"
, "xmonad --deps: print dependencies"
]
connectDBus :: IO DBusState
connectDBus = do
sesClient <- startXMonadService
sysClient <- getDBusClient True
return DBusState
{ dbSessionClient = sesClient
, dbSystemClient = sysClient
}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Concurrency configuration -- | Concurrency configuration
data DBusState = DBusState
{ dbSessionClient :: Maybe Client
, dbSystemClient :: Maybe Client
}
data ThreadState = ThreadState data ThreadState = ThreadState
{ tsSessionClient :: Maybe Client { tsChildPIDs :: [ProcessHandle]
, tsSystemClient :: Maybe Client
, tsChildPIDs :: [ProcessHandle]
, tsChildHandles :: [Handle] , tsChildHandles :: [Handle]
} }
-- TODO shouldn't this be run by a signal handler? -- TODO shouldn't this be run by a signal handler?
runCleanup :: ThreadState -> X () runCleanup :: ThreadState -> DBusState -> X ()
runCleanup ts = io $ do runCleanup ts db = io $ do
mapM_ killHandle $ tsChildPIDs ts mapM_ killHandle $ tsChildPIDs ts
forM_ (tsSessionClient ts) stopXMonadService forM_ (dbSessionClient db) stopXMonadService
forM_ (tsSystemClient ts) disconnect forM_ (dbSystemClient db) disconnect
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Startuphook configuration -- | Startuphook configuration
@ -504,8 +543,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbMaybeAction = a } = case a of
(Just x) -> Just $ k{ kbMaybeAction = x } (Just x) -> Just $ k{ kbMaybeAction = x }
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip } Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX] externalBindings :: ThreadState -> DBusState -> X () -> [KeyGroup FeatureX]
externalBindings ts lock = externalBindings ts db lock =
[ KeyGroup "Launchers" [ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -564,7 +603,7 @@ externalBindings ts lock =
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock
-- M-<F1> reserved for showing the keymap -- M-<F1> reserved for showing the keymap
, KeyBinding "M-<F2>" "restart xmonad" $ ConstFeature (runCleanup ts >> runRestart) , KeyBinding "M-<F2>" "restart xmonad" $ ConstFeature (runCleanup ts db >> runRestart)
, KeyBinding "M-<F3>" "recompile xmonad" $ ConstFeature runRecompile , KeyBinding "M-<F3>" "recompile xmonad" $ ConstFeature runRecompile
, KeyBinding "M-<F7>" "start Isync Service" runStartISyncService , KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
, KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer , KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
@ -576,7 +615,7 @@ externalBindings ts lock =
] ]
] ]
where where
cl = tsSessionClient ts cl = dbSessionClient db
brightessControls ctl getter = (ioFeature . getter . ctl) cl brightessControls ctl getter = (ioFeature . getter . ctl) cl
ib = brightessControls intelBacklightControls ib = brightessControls intelBacklightControls
ck = brightessControls clevoKeyboardControls ck = brightessControls clevoKeyboardControls

View File

@ -113,7 +113,7 @@ featureEndpoint name busname path iface mem client = Feature
, ftrWarning = Default , ftrWarning = Default
} }
where where
cmd = \c -> void $ callMethod c busname path iface mem cmd c = void $ callMethod c busname path iface mem
deps = [Endpoint busname path iface $ Method_ mem] deps = [Endpoint busname path iface $ Method_ mem]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------