ENH use optparse for xmonad

This commit is contained in:
Nathan Dwarshuis 2023-01-01 11:41:04 -05:00
parent 0e1b117639
commit dea4ab6585
2 changed files with 66 additions and 52 deletions

View File

@ -16,6 +16,7 @@ import Data.Text.IO (hPutStrLn)
import Graphics.X11.Types
import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras
import Options.Applicative hiding (action)
import RIO
import RIO.Directory
import RIO.List
@ -26,7 +27,6 @@ import System.Process
( getPid
, getProcessExitCode
)
import UnliftIO.Environment
import XMonad
import XMonad.Actions.CopyWindow
import XMonad.Actions.CycleWS
@ -66,15 +66,38 @@ import XMonad.Util.NamedActions
import XMonad.Util.WorkspaceCompare
main :: IO ()
main = getArgs >>= parse
main = parse >>= xio
parse :: [String] -> IO ()
parse [] = run
parse ["--deps"] = withCache printDeps
-- parse ["--test"] = void $ withCache . evalConf =<< connectDBusX
parse _ = usage
parse :: IO XOpts
parse = execParser opts
where
parseOpts = parseDeps <|> parseTest <|> pure XRun
opts =
info (parseOpts <**> helper) $
fullDesc <> header "xmonad: the best window manager ever"
run :: IO ()
data XOpts = XDeps | XTest | XRun
parseDeps :: Parser XOpts
parseDeps =
flag'
XDeps
(long "deps" <> short 'd' <> help "print dependencies")
parseTest :: Parser XOpts
parseTest =
flag'
XTest
(long "test" <> short 't' <> help "test dependencies without running")
xio :: XOpts -> IO ()
xio o = withCache $
case o of
XDeps -> printDeps
XTest -> undefined
XRun -> run
run :: FIO ()
run = do
-- These first two commands are only significant when xmonad is restarted.
-- The 'launch' function below this will turn off buffering (so flushes are
@ -89,41 +112,40 @@ run = do
-- signal handlers to carry over to the top.
uninstallSignalHandlers
hSetBuffering stdout LineBuffering
withCache $ do
withDBusX_ $ \db -> do
let fs = features $ dbSysClient db
startDBusInterfaces db fs
withXmobar $ \xmobarP -> do
withChildDaemons fs $ \ds -> do
let ts = ThreadState ds (Just xmobarP)
void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
void $ async $ void $ executeSometimes $ fsPowerMon fs
dws <- startDynWorkspaces fs
runIO <- askRunInIO
let cleanup = runCleanup runIO ts db
kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup db)
sk <- evalAlways $ fsShowKeys fs
ha <- evalAlways $ fsACPIHandler fs
tt <- evalAlways $ fsTabbedTheme fs
let conf =
ewmh $
addKeymap dws sk kbs $
docks $
def
{ terminal = myTerm
, modMask = myModMask
, layoutHook = myLayouts tt
, manageHook = myManageHook dws
, handleEventHook = myEventHook ha
, startupHook = myStartupHook
, workspaces = myWorkspaces
, logHook = myLoghook xmobarP
, clickJustFocuses = False
, focusFollowsMouse = False
, normalBorderColor = T.unpack XT.bordersColor
, focusedBorderColor = T.unpack XT.selectedBordersColor
}
io $ runXMonad conf
withDBusX_ $ \db -> do
let fs = features $ dbSysClient db
startDBusInterfaces db fs
withXmobar $ \xmobarP -> do
withChildDaemons fs $ \ds -> do
let ts = ThreadState ds (Just xmobarP)
void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
void $ async $ void $ executeSometimes $ fsPowerMon fs
dws <- startDynWorkspaces fs
runIO <- askRunInIO
let cleanup = runCleanup runIO ts db
kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup db)
sk <- evalAlways $ fsShowKeys fs
ha <- evalAlways $ fsACPIHandler fs
tt <- evalAlways $ fsTabbedTheme fs
let conf =
ewmh $
addKeymap dws sk kbs $
docks $
def
{ terminal = myTerm
, modMask = myModMask
, layoutHook = myLayouts tt
, manageHook = myManageHook dws
, handleEventHook = myEventHook ha
, startupHook = myStartupHook
, workspaces = myWorkspaces
, logHook = myLoghook xmobarP
, clickJustFocuses = False
, focusFollowsMouse = False
, normalBorderColor = T.unpack XT.bordersColor
, focusedBorderColor = T.unpack XT.selectedBordersColor
}
io $ runXMonad conf
where
startDynWorkspaces fs = do
dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
@ -237,15 +259,6 @@ allFeatures db = withRunInIO $ \runIO -> do
where
ts = ThreadState {tsChildPIDs = [], tsXmobar = Nothing}
usage :: IO ()
usage =
putStrLn $
intercalate
"\n"
[ "xmonad: run greatest window manager"
, "xmonad --deps: print dependencies"
]
--------------------------------------------------------------------------------
-- Concurrency configuration

View File

@ -35,6 +35,7 @@ dependencies:
- typed-process >= 0.2.8.0
- network >= 3.1.2.7
- unliftio >= 0.2.21.0
- optparse-applicative >= 0.16.1.0
library:
source-dirs: lib/