From dea4ab6585d693bf21d17ce05e6be559d108ede2 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 1 Jan 2023 11:41:04 -0500
Subject: [PATCH] ENH use optparse for xmonad

---
 bin/xmonad.hs | 117 ++++++++++++++++++++++++++++----------------------
 package.yaml  |   1 +
 2 files changed, 66 insertions(+), 52 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 14fa0d1..5a3c4d3 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -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
 
diff --git a/package.yaml b/package.yaml
index 67888d1..b471e6c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -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/